{$X+,O+,F+}
unit ExecPrim;

interface

uses Dos, Objects, Drivers, Views, Dialogs, ProgList;

const
  mnSwap = 0;
  mnUnload = 1;
  mnNone = 2;
  mnArc = 3;
  mnView = 4;
  mnXView = 5;
  mnEdit = 6;
  mnXEdit = 7;
  mndBASE = 8;
  mnPanel = 9;
  mnIcon = 10;
  mnHelp = 11;
  mnHTML = 12;
  mnPrint = 13;
  mnMenu = 14;
  mnEmpty = $FF;

  suSaveEditorFiles = 1;
  suSaveDesktop = 2;
  suLoadSnipper = 4;

  opMessage        = $0001;
  opLoadCOMMANDCOM = $0002;
  opSwapToDisk     = $0004;
  opNoRedraw       = $0020;
  opNoReread       = $0040;
  opNoMsgWin       = $0080;
  opNoXfer         = $0100;
  opUserScr        = $0800;
  opStdError       = $1000;
  opInfoBit        = $4000;
  opPrepared       = $8000;

  ProgramCalled: Boolean = False;
  MultiExec: Boolean = False;

  SourceName: FNameStr = '';

  IconParams: PString = nil;

  PrgName = 'CONNECT.PRG';
  ExtName = 'CONNECT.EXT';
  ViewerName = 'CONNECT.VIE';
  QuickViewerName = 'CONNECT.QVW';
  ExecRecName = 'CONNECT.EXR';
  SelListName = 'SELECTED.LST';

var
  ExecRec: TExecRec;
  ExecMem: Longint;

procedure SetPrgName(P: PString; var Name: FNameStr);
procedure ProgDlg(P: PString);
procedure UserMenuDlg(P: PString);
procedure ExecHotKey(var Event: TEvent);
procedure WaitForProgram;
procedure ExtDlg(const AFocusName: FNameStr);
procedure ViewDlg(const AFocusName: FNameStr);
function ExtractExecRec(var Rec: TExecRec;
  const Name: FNameStr; AKey: Word; Viewer: Boolean): Boolean;

function ValidateParams(var Params: String): Boolean;
procedure PrepareExecEvent;
function PrepareExecPrim: Boolean;
procedure CancelExecution;
procedure LoadMultiExecRec;
procedure SaveMsgFilters;

implementation

uses
  Memory, App, MsgBox, Hotkeys, KeyDlg, Funcs, HistList, History, HistWin,
  Desktops, ExtList, EditMsg, EditFile, FMUsrMnu, FMSecond, DirPrim, Swaps,
  ProgPath, RevPos, StrFiles, Strings, Spooler, EnvDlg, UserScr, HeapUMB,
  LFN, DosTools, TPString, Consts, Commands, Defaults;

const
  ExecCollection: PCollection = nil;
  ExecColIndex: Integer = 0;
  ExecColPos: Word = 0;

  smNot = 0;
  smShort = 1;
  smLong = 2;
  SourceMsgSent: Byte = smNot;

(*
function DataAddress(P: Pointer): Pointer;
type
  SO = record
    O, S: Word;
  end;
  JumpInstr = record
    Opcode: Byte;
    Address: Pointer;
  end;
begin
  if SO(P).S <> CSeg then DataAddress := JumpInstr(P^).Address
  else DataAddress := P;
end;

{$L EXECMAC.OBJ}
procedure EXECDirectives; external;

type
  PExecDirectives = ^TExecDirectives;
  TExecDirectives = Array[edXVIEW..edMEM] of String[8];

function Directives(Index: Integer): String;
begin
  Directives := PExecDirectives(DataAddress(@EXECDirectives))^[Index];
end;
*)

const
  edFirst    = 0;
  edARC      = 0;
  edCN       = 1;
  edDAY      = 2; 
  edDBASE    = 3; 
  edDIRARC   = 4; 
  edEDIT     = 5; 
  edENV      = 6; 
  edERR      = 7; 
  edEXT      = 8; 
  edFILTER   = 9; 
  edFINDDIR  = 10;
  edFINDNAME = 11;
  edFNAME    = 12;
  edFYEAR    = 13;
  edGET      = 14;
  edHELP     = 15;
  edHIST     = 16;
  edHOUR     = 17;
  edHREF     = 18;
  edHTML     = 19;
  edICON     = 20;
  edKBD      = 21;
  edLEFT     = 22;
  edLEXT     = 23;
  edLFNAME   = 24;
  edLLEFT    = 25;
  edLNAME    = 26;
  edLOEXT    = 27;
  edLONAME   = 28;
  edLOPATH   = 29;
  edLOPP     = 30;
  edLPATH    = 31;
  edLRIGHT   = 32;
  edLSEL     = 33;
  edMAC      = 34;
  edMEM      = 35;
  edMENU     = 36;
  edMIN      = 37;
  edMONTH    = 38;
  edMSEC     = 39;
  edMSG      = 40;
  edNAME     = 41;
  edNMW      = 42;
  edNOMSGWIN = 43;
  edNOREDRAW = 44;
  edNOREREAD = 45;
  edNRD      = 46;
  edNRR      = 47;
  edNTM      = 48;
  edOEXT     = 49;
  edONAME    = 50;
  edOPATH    = 51;
  edOPPOSITE = 52;
  edPANEL    = 53;
  edPATH     = 54;
  edPRG      = 55;
  edPRINT    = 56;
  edPROMPT   = 57;
  edPUT      = 58;
  edRDBLK    = 59;
  edREPORT   = 60;
  edRIGHT    = 61;
  edSAMEWIN  = 62;
  edSEC      = 63;
  edSEL      = 64;
  edSET      = 65;
  edSWAPDIR  = 66;
  edUSERSCR  = 67;
  edUSR      = 68;
  edVIEW     = 69;
  edVM       = 70;
  edWORD     = 71;
  edWRBLK    = 72;
  edXEDIT    = 73;
  edXM       = 74;
  edXVIEW    = 75;
  edXW       = 76;
  edXX       = 77;
  edYEAR     = 78;
  edLast     = 78;

  Directives: Array[edFirst..edLast] of String[8] =
    ('ARC', 'CN', 'DAY', 'DBASE', 'DIRARC', 'EDIT', 'ENV', 'ERR', 'EXT', 
     'FILTER', 'FINDDIR', 'FINDNAME', 'FNAME', 'FYEAR', 'GET', 'HELP', 
     'HIST', 'HOUR', 'HREF', 'HTML', 'ICON', 'KBD', 'LEFT', 'LEXT', 
     'LFNAME', 'LLEFT', 'LNAME', 'LOEXT', 'LONAME', 'LOPATH', 'LOPP', 
     'LPATH', 'LRIGHT', 'LSEL', 'MAC', 'MEM', 'MENU', 'MIN', 'MONTH', 
     'MSEC', 'MSG', 'NAME', 'NMW', 'NOMSGWIN', 'NOREDRAW', 'NOREREAD',
     'NRD', 'NRR', 'NTM', 'OEXT', 'ONAME', 'OPATH', 'OPPOSITE', 'PANEL',
     'PATH', 'PRG', 'PRINT', 'PROMPT', 'PUT', 'RDBLK', 'REPORT', 'RIGHT',
     'SAMEWIN', 'SEC', 'SEL', 'SET', 'SWAPDIR', 'USERSCR', 'USR', 'VIEW', 
     'VM', 'WORD', 'WRBLK', 'XEDIT', 'XM', 'XVIEW', 'XW', 'XX', 'YEAR');

  XXRecur: Boolean = False;
  XXNamePtr: PString = nil;

procedure SetAssocName(const MaskName: FNameStr; var Name: FNameStr);
begin
  if LocalAssocs then
  begin
    GetCurDir(0, Name);
    repeat
      Name := AddedSlash(Name) + MaskName;
      LogEvent := lcDiskRead;
      DrawStatusLine('Searching for local association file ' +
	TrimmedName(Name, 30) + '.');
      if ThisFileExists(Name) then Exit;
      if Length(Name) < Length(MaskName) + 5 then Break;
      Name := PrevDir(JustPathName(Name));
    until False;
  end;
  Name := ConfigPath + MaskName;
end;

procedure SetPrgName(P: PString; var Name: FNameStr);
var
  I, Code: Integer;
  S: String;
begin
  if P <> nil then
  begin
    S := P^;
    I := Pos(' ', S);
    if I <> 0 then
    begin
      Val(Trim(Copy(S, I + 1, 255)), LastProgIndex, Code);
      if LastProgIndex > 0 then Dec(LastProgIndex);
      S[0] := Char(I - 1);
    end
    else LastProgIndex := 0;
    Name := lFExpand(S);
  end
  else SetAssocName(PrgName, Name);
end;

procedure SetExtName(var Name: FNameStr);
begin
  SetAssocName(ExtName, Name);
end;

procedure SetViewerName(var Name: FNameStr);
begin
  SetAssocName(ViewerName, Name);
end;

procedure SetQuickViewerName(var Name: FNameStr);
begin
  SetAssocName(QuickViewerName, Name);
end;

procedure SetExecRecName(var Name: FNameStr);
begin
  Name := ConfigPath + ExecRecName;
end;

procedure ProgDlg(P: PString);
var
  Name: FNameStr;
begin
  SetPrgName(P, Name);
  if Application^.ExecuteDialog(
    New(PProgDialog, Init(Name, '')), @ExecRec, True) <> cmCancel then
      PrepareExecEvent;
end;

procedure UserMenuDlg(P: PString);
var
  Name: FNameStr;
begin
  SetPrgName(P, Name);
  if Application^.ExecuteDialog(
    New(PUserMenuDialog, Init(Name, '')), @ExecRec, True) <> cmCancel then
      PrepareExecEvent;
end;

procedure ReadPrograms(Name: FNameStr; var Programs: PCollection);
var
  Item: PExecItem;
  S: TDosStream;
begin
  Programs := New(PCollection, Init(16, 16));
  LogEvent := lcDiskRead;
  DrawStatusLine('Loading programs from ' + TrimmedName(Name, 45) + '.');
  S.Init(Name, stOpenRead);
  if S.Status = stOk then
  begin
    while not LowMemory do
    begin
      Item := PExecItem(S.Get);
      if S.Status <> stOk then
      begin
        CouldNotReadMsgBox(Name);
        Break;
      end
      else if Item = nil then Break;
      Programs^.Insert(Item);
    end;
  end;
  S.Done;
end;

procedure ExecHotKey(var Event: TEvent);
var
  Found: Boolean;
  KbdState: Byte;
  Key: Word;
  I: Integer;
  P: PExecItem;
begin
  KbdState := GetShiftState;
  Key := Event.KeyCode;
  GlobalSequence[ExecColPos] := Key;
  Found := False;
  while ExecColIndex < ExecCollection^.Count do
  begin
    P := ExecCollection^.At(ExecColIndex);
    if P = nil then Break;
    if (ExecColPos = 0) and SameKey(Key, P^.HotKey) then
    begin
      Found := True;
      Break;
    end;
    if (P^.HotKey = hkSeq) and (ExecColPos < P^.HotKeyCount) and
      SameSequence(GlobalSequence, P^.HotKeySequence^, ExecColPos + 1) and
      HotKeyOptMatch(KbdState, P^.HotKeyOpt, ExecColPos) then
    begin
      if ExecColPos = P^.HotKeyCount - 1 then
      begin
        Found := True;
        Break;
      end;
      DrawSequenceStatusLine(ExecColPos);
      Inc(ExecColPos);
      Event.What := evNothing;
      Exit;
    end;
    Inc(ExecColIndex);
  end;
  if Found then
  begin
    P^.GetData(ExecRec, Key);
    PrepareExecEvent;
  end;
  Dispose(ExecCollection, Done);
  ExecCollection := nil;
  ExecColIndex := 0;
  ExecColPos := 0;
  ProgramCalled := False;
end;

procedure WaitForProgram;
var
  S: FNameStr;
begin
  if ExecCollection = nil then
  begin
    SetPrgName(nil, S);
    ReadPrograms(S, ExecCollection);
  end;
  StatusLine^.Update;
  DrawStatusLine('Waiting for user program hotkey.');
  ProgramCalled := True;
end;

procedure ExtDlg(const AFocusName: FNameStr);
var
  Name: FNameStr;
begin
  SetExtName(Name);
  Application^.ExecuteDialog(
    New(PAssocDialog, Init(Name, AFocusName, False)), @ExecRec, False);
end;

procedure ViewDlg(const AFocusName: FNameStr);
var
  Name: FNameStr;
begin
  if GetShiftState and (kbLeftShift + kbRightShift) <> 0 then
    SetQuickViewerName(Name)
  else SetViewerName(Name);
  Application^.ExecuteDialog(
    New(PAssocDialog, Init(Name, AFocusName, True)), @ExecRec, False);
end;

function ExtractExecRec(var Rec: TExecRec;
  const Name: FNameStr; AKey: Word; Viewer: Boolean): Boolean;
var
  Found, NextFound: Boolean;
  W: Word;
  Item, NextItem: PExecItem;
  List: PCollection;
  S: TDosStream;
  FName: FNameStr;
  Mask, Title, Condition: String;

procedure GetAssocSelection;
const
  AssocHistoryID = 199;
var
  B: Boolean;
  C: Word;
  I: Integer;
  P: PHistoryRec;
  W: PHistoryWindow;
  R: TRect;
begin
  Rec.Path := #0;
  Found := False;

  List := New(PCollection, Init(4, 4));
  List^.Insert(Item);
  repeat
    List^.Insert(NextItem);
    NextItem := PExecItem(S.Get);
    if NextItem <> nil then
    begin
      if (S.Status = stOk) and (NextItem^.HotKey = AKey) and
         (NextItem^.Title <> nil) and not LowMemory then
      begin
        SplitExecTitle(NextItem, Mask, Title, Condition);
        if WildCardMatch(Name, Mask) then Continue;
      end;
      Dispose(NextItem, Done);
    end;
    Break;
  until False;

  for I := 0 to List^.Count - 1 do
  begin
    Item := List^.At(I);
    SplitExecTitle(Item, Mask, Title, Condition);
    B := Condition <> '';
    if B then Break;
  end;

  if B then
  begin
    for I := List^.Count - 1 downto 0 do
    begin
      Item := List^.At(I);
      SplitExecTitle(Item, Mask, Title, Condition);
      if not ConditionOK(Condition) then List^.AtFree(I);
    end;

    if List^.Count <= 1 then
    begin
      if List^.Count = 1 then
      begin
        Item := List^.At(0);
        List^.AtDelete(0);
        Found := True;
      end;
      Dispose(List, Done);
      Exit;
    end;
  end;

  for I := List^.Count - 1 downto 0 do
  begin
    Item := List^.At(I);
    SplitExecTitle(Item, Mask, Title, Condition);
    if Title = '' then Title := 'Untitled';
    PadSt(Title, ExecTitleLen + 2);
    if Item^.Path <> nil then Title := Title + Item^.Path^;
{
    GetMem(P, SizeOf(THistoryRec));
    P^.StrPtr := NewStr(Title);
}
    GetMemUMB(P, SizeOf(THistoryRec));
    P^.StrPtr := NewStrUMB(Title);
    P^.Id := AssocHistoryId;
    if I < 9 then Byte(P^.Lock) := I + $31
    else P^.Lock := False;
    HistoryList^.Insert(P);
  end;

  if Viewer then Title := 'viewers'
  else Title := 'associations';
  GetHistWinBounds(AssocHistoryID, '', R);
  R.B.X := R.A.X + 38;
  W := New(PSpecialHistWindow, Init(R, AssocHistoryID));
  DisposeStr(W^.Title);
  W^.Title := NewStr(Mask + ' ' + Title);
  W^.Options := W^.Options or ofCentered;
  W^.HelpCtx := hcAssocHistory;
  if Application^.ValidView(W) <> nil then
  begin
    C := Desktop^.ExecView(W);
    if C = cmOk then
    begin
      I := W^.Viewer^.Focused;
      Item := List^.At(I);
      List^.AtDelete(I);
      Found := True;
    end;
    Dispose(W, Done);
  end;
  ClearHistoryId(AssocHistoryID);
  Dispose(List, Done);
end;

begin
  Rec.Path := '';
  Found := False;
  NextFound := False;
  if Byte(Viewer) = 2 then SetQuickViewerName(FName)
  else if Viewer then SetViewerName(FName)
  else SetExtName(FName);
  S.Init(FName, stOpenRead);
  while not Found and (S.Status = stOk) do
  begin
    Item := PExecItem(S.Get);
    if Item <> nil then
    begin
      if (Item^.HotKey = AKey) and (Item^.Title <> nil) then
      begin
	SplitExecTitle(Item, Mask, Title, Condition);
	Found := WildCardMatch(Name, Mask);
	if Found then
	begin
          NextItem := PExecItem(S.Get);
          if NextItem <> nil then
          begin
	    if (NextItem^.HotKey = AKey) and (NextItem^.Title <> nil) then
            begin
              SplitExecTitle(NextItem, Mask, Title, Condition);
              NextFound := WildCardMatch(Name, Mask);
              if NextFound then
              begin
                GetAssocSelection;
                Break;
              end;
            end;
            if not NextFound then Dispose(NextItem, Done)
          end;
        end;
      end;
      if not Found then Dispose(Item, Done)
    end;
  end;
  S.Done;
  if Found then
  begin
    SplitExecTitle(Item, Mask, Title, Condition);
    Item^.GetData(Rec, W);
    Dispose(Item, Done);
    ExtractExecRec := (Rec.Path <> '') and ConditionOk(Condition);
  end
  else ExtractExecRec := False;
end;

procedure GetValidSource(Long: Boolean);
var
  P: PString;
begin
  if SourceMsgSent = Byte(Long) + 1 then Exit;
  if XXNamePtr <> nil then P := XXNamePtr
  else P := Message(Application, evBroadcast, cmGetSource, nil);
  if P = nil then SourceName := ''
  else
  begin
    SourceName := P^;
    if (XXNamePtr = nil) and not Long then
      lGetShortFileName(SourceName, SourceName);
  end;
  SourceMsgSent := Byte(Long) + 1;
end;

procedure GetOppSource(Long: Boolean; var Name: FNameStr);
var
  P: PString;
begin
  P := Message(Application, evBroadcast, cmGetOppSource, nil);
  if P = nil then Name := ''
  else
  begin
    Name := P^;
    if not Long then lGetShortFileName(Name, Name);
  end;
end;

procedure GetValidArcDir(var Name: FNameStr);
var
  P: PString;
begin
  P := Message(Application, evBroadcast, cmGetArcDir, nil);
  if P = nil then Name := ''
  else Name := P^;
{  UpcaseSt(Name);}
end;

procedure ConvertExecStr(const P: String; var S: String);
var
  I: Integer;
begin
  S := '';
  for I := 1 to Length(P) do
  begin
    Inc(S[0]);
    if P[I] = '(' then S[I] := ''
    else if P[I] = ')' then S[I] := ''
    else S[I] := TPString.Upcase(P[I]);
  end;
end;

procedure InvalidVMMsgBox;
begin
  MessageBox(
    ^C'Bad or missing custom video mode parameter. Valid range is: 0..255',
    nil, mfError + mfOkButton);
end;

function ValidateParams(var Params: String): Boolean;
const
  MaxKeys = 16;
var
  Cancel: Boolean;
  B, E, K, P, Code: Integer;
  L: Longint;
  PS: PString;
  Keys: Array[0..MaxKeys - 1] of Word;
  F: Text;
  S, CS, ES, Name: String;

procedure ReplaceText(Count: Integer);
begin
  Delete(CS, P, Count);
  Insert(Name, CS, P);
  Delete(ES, P, Count);
  Insert(Name, ES, P);
end;

procedure FindClosingArrow;
var
  C: Byte;
begin
  C := 0;
  E := B;
  while (E <> 0) and (E <= Length(ES)) do
  begin
    if ES[E] = '' then Inc(C)
    else if ES[E] = '' then
      if C <> 0 then Dec(C) else Exit;
    Inc(E);
  end;
end;

procedure ProcessOpenDirective(const Directive: String);
begin
  B := P + Length(Directive) + 1;
  if (Length(ES) >= B) and (ES[B] = '') then
  begin
    Inc(B);
    FindClosingArrow;
    Name := Copy(CS, B, E - B);
  end
  else if Directive[1] = 'A' then Name := '$' + Directive
  else
  begin
    GetValidSource(True);
    Name := SourceName;
  end;
  CS := lFExpand(Name);
  ES := '';
  P := 0;
  if Name = '' then ExecRec.Main := mnEmpty
  else
  case Directive[1] of
    'A': ExecRec.Main := mnArc;
    'V': ExecRec.Main := mnView;
    'E': ExecRec.Main := mnEdit;
    'D': ExecRec.Main := mndBASE;
    'I': ExecRec.Main := mnIcon;
    'M': ExecRec.Main := mnMenu;
    'P': if Directive[2] = 'A' then ExecRec.Main := mnPanel
         else ExecRec.Main := mnPrint;
    'H': if Directive[2] = 'E' then ExecRec.Main := mnHelp
         else ExecRec.Main := mnHTML;
    else if Directive[2] = 'E' then
         ExecRec.Main := mnXEdit else
         ExecRec.Main := mnXView;
  end;
end;

procedure ProcessCNDirective;
begin
  Name := ClearedSlash(ProgramPath);
  ReplaceText(3);
end;

procedure ProcessDateTimeDirective(Index: Integer);
var
  H, M, S, HS: Word;

procedure LeftPadZero(W, L: Word);
begin
  Str(W, Name);
  while Length(Name) < L do Name := '0' + Name;
  while Length(Name) > L do Delete(Name, 1, 1);
end;

begin
  case Index of
    edDAY, edMONTH, edYEAR, edFYEAR: GetDate(H, M, S, HS);
    else GetTime(H, M, S, HS);
  end;
  case Index of
    edDAY: LeftPadZero(S, 2);
    edMONTH: LeftPadZero(M, 2);
    edYEAR: LeftPadZero(H, 2);
    edFYEAR: LeftPadZero(H, 4);
    edHOUR: LeftPadZero(H, 2);
    edMIN: LeftPadZero(M, 2);
    edSEC: LeftPadZero(S, 2);
    else LeftPadZero(HS, 3);
  end;
  ReplaceText(Length(Directives[Index]) + 1);
end;

procedure ProcessDIRARCDirective;
begin
  GetValidArcDir(Name);
  Name := ClearedSlash(Name);
  ReplaceText(7);
end;

procedure ProcessENVDirective;
begin
  B := P + 5;
  FindClosingArrow;
  Name := GetEnvUC(Copy(CS, B, E - B));
  ReplaceText(E - P + 1);
end;

procedure ProcessEXTDirective(const Directive: String);
begin
  GetValidSource(Directive[1] = 'L');
  Name := JustExtension(SourceName);
  if Name <> '' then Name := '.' + Name;
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessOEXTDirective(const Directive: String);
begin
  GetOppSource(Directive[1] = 'L', Name);
  Name := JustExtension(Name);
  if Name <> '' then Name := '.' + Name;
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessFINDNAMEDirective(const Directive: String);
begin
  B := P + Length(Directive) + 2;
  FindClosingArrow;
  S := Copy(CS, B, E - B);
  Name := FSearch(S, GetEnv('PATH'));
  if Name = '' then Name := S;
  Name := FExpand(Name);
  if Directive[5] = 'D' then
    Name := ClearedSlash(JustPathName(Name));
  ReplaceText(E - P + 1);
end;

procedure ProcessFNAMEDirective(const Directive: String);
var
  SaveAPI: lAPIType;
begin
  B := P + Length(Directive) + 1;
  if (Length(ES) >= B) and (ES[B] = '') then
  begin
    Inc(B);
    FindClosingArrow;
    S := Copy(CS, B, E - B);
  end
  else
  begin
    S := HistoryStr(HistoryID, 0);
    E := B - 1;
  end;
  SaveAPI := lAPI;
  if Directive[1] <> 'L' then lAPI := lDOS;
  if not GetFName(S) then Cancel := True
  else
  begin
    Name := S;
    ReplaceText(E - P + 1);
  end;
  lAPI := SaveAPI;
end;

procedure ProcessGETDirective;
var
  N: Integer;
  StrFile: TStrFile;
begin
  B := P + 5;
  FindClosingArrow;
  S := Copy(CS, B, E - B);
  N := Pos('>', S);
  if N <> 0 then
  begin
    StrFile.Init(lFExpand(Trim(Copy(S, 1, N - 1))));
    StrFile.GetStr(Copy(S, N + 1, 255), S);
    StrFile.Done;
  end
  else S := '';
  Name := S;
  ReplaceText(E - P + 1);
end;

procedure ProcessKBDDirective;

procedure StrToKeys(const KS: String);
begin
  if (K <> 0) and (KS[1] = '$') and Str2Long(KS, L) and
     (L > 0) and (L <= $FFFF) then
  begin
    Dec(K);
    Keys[K] := LongRec(L).Lo;
  end
  else
  begin
    B := Length(KS);
    while (B <> 0) and (K <> 0) do
    begin
      Dec(K);
      Keys[K] := Byte(KS[B]);
      Dec(B);
    end;
  end;
end;

begin
  B := P + 5;
  FindClosingArrow;
  StrToKeys(Copy(CS, B, E - B));
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessGETSTRDirective(const Directive: String; ACommand: Word);
begin
  PS := Message(Application, evBroadcast, ACommand, nil);
  if PS <> nil then Name := PS^ else Name := '';
  if (ACommand <> cmGetWord) and (ACommand <> cmHRef) and
     ((Directive[1] <> 'L') or (Directive[2] = 'E')) then
    lGetShortFileName(Name, Name);
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessHISTDirective;
begin
  GetExecHistStr(Name, 'Exec history', True, True);
  if Name = '' then Cancel := True
  else
  begin
    B := Pos(' ', Name);
    if B <> 0 then
    begin
      ExecRec.Params := Trim(Copy(Name, B + 1, 255));
      Name[0] := Char(B - 1);
    end;
    ReplaceText(5);
  end;
end;

procedure ProcessMEMDirective;
begin
  B := P + 5;
  FindClosingArrow;
  Val(Copy(CS, B, E - B), L, Code);
  if Code = 0 then ExecMem := L * 1024 + LowMemSize * 16;
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessMSGDirective;
begin
  B := P + 4;
  if (Length(ES) >= B) and (ES[B] = '') then
  begin
    Inc(B);
    FindClosingArrow;
    Name := ' | ' + Copy(CS, B, E - B);
    ExecRec.Options := ExecRec.Options or opLoadCOMMANDCOM;
  end
  else
  begin
    Name := '';
    E := B - 1;
  end;
  ExecRec.Options := ExecRec.Options or opMessage;
  ReplaceText(E - P + 1);
end;

procedure ProcessNAMEDirective(const Directive: String);
begin
  GetValidSource(Directive[1] = 'L');
  Name := JustName(SourceName);
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessONAMEDirective(const Directive: String);
begin
  GetOppSource(Directive[1] = 'L', Name);
  Name := JustName(Name);
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessFLAGDirective(const Directive: String; AMask: Word);
begin
  ExecRec.Options := ExecRec.Options or AMask;
  Name := '';
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessPATHDirective(const Directive: String);
begin
  GetValidSource(Directive[1] = 'L');
  Name := AddBackSlash(JustPathName(SourceName));
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessOPATHDirective(const Directive: String);
begin
  GetOppSource(Directive[1] = 'L', Name);
  Name := AddBackSlash(JustPathName(Name));
  ReplaceText(Length(Directive) + 1);
end;

procedure ProcessPROMPTDirective;
var
  ATitle, ALabel: String[127];
begin
  ATitle := '';
  ALabel := '';

  B := P + 7;
  if (Length(ES) >= B) and (ES[B] = '') then
  begin
    Inc(B);
    FindClosingArrow;
    S := Copy(CS, B, E - B);

    B := 1;
    while (B < Length(S)) do
    begin
      if S[B] = ',' then
        if S[B + 1] = ',' then Delete(S, B, 1)
        else
        begin
          ALabel := Copy(S, B + 1, 255);
          S[0] := Char(B - 1);
        end;
      Inc(B);
    end;

    if ALabel <> '' then
    begin
      B := 1;
      while (B < Length(ALabel)) do
      begin
        if ALabel[B] = ',' then
          if ALabel[B + 1] = ',' then Delete(ALabel, B, 1)
          else
          begin
            ATitle := Copy(ALabel, B + 1, 255);
            ALabel[0] := Char(B - 1);
          end;
        Inc(B);
      end;
    end;
  end
  else
  begin
    S := HistoryStr(PromptHistoryID, 0);
    E := B - 1;
  end;

  if not GetPrompt(S, ATitle, ALabel) then Cancel := True
  else
  begin
    Name := S;
    ReplaceText(E - P + 1);
  end;
end;

procedure ProcessPUTDirective;
var
  StrFile: TStrFile;
begin
  B := P + 5;
  FindClosingArrow;
  S := Copy(CS, B, E - B);
  B := Pos('<', S);
  if B <> 0 then
  begin
    StrFile.Init(lFExpand(Trim(Copy(S, 1, B - 1))));
    Delete(S, 1, B);
    B := Pos('=', S);
    if B <> 0 then StrFile.PutStr(
      Copy(S, 1, B - 1), Copy(S, B + 1, 255));
    StrFile.Done;
  end;
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessBLKDirective(const Directive: String;
  AMask, ACommand: Word);
begin
  B := P + Length(Directive) + 2;
  FindClosingArrow;
  S := Copy(CS, B, E - B);
  Name := '';
  ReplaceText(E - P + 1);
  Message(Application, AMask, ACommand, @S);
end;

procedure ProcessREPORTDirective;
begin
  Name := ReportFile;
  ReplaceText(7);
end;

procedure ProcessSELDirective(const Directive: String);
var
  C: Word;
begin
  B := P + Length(Directive) + 1;
  if (Length(ES) >= B) and (ES[B] = '') then
  begin
    Inc(B);
    FindClosingArrow;
    S := Copy(CS, B, E - B);
  end
  else
  begin
    GetValidSwapDir(Name, False);
    Name := Name + SelListName;
    E := B - 1;
  end;
  ReplaceText(E - P + 1);
  Assign(F, Name);
  Rewrite(F);
  if IOResult = 0 then
  begin
    Close(F);
    if Directive[1] = 'L' then C := cmLSaveSelected
    else C := cmSaveSelected;
    Message(Application, evBroadcast, C, @Name);
  end
  else MessageBox(^C'Could not create list file'#13^C +
    TrimmedName(Name, 33) + '.', nil, mfError + mfOkButton);
end;

procedure ProcessSETDirective;
begin
  B := P + 5;
  FindClosingArrow;
  SetEnvVar(Copy(CS, B, E - B));
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessSWAPDIRDirective;
begin
  GetValidSwapDir(Name, False);
  Name := ClearedSlash(Name);
  ReplaceText(8);
end;

procedure ProcessVMDirective;
var
  SaveRestore: Boolean;
begin
  B := P + 4;
  FindClosingArrow;
  Val(Copy(CS, B, E - B), L, Code);
  if (Code = 0) and (L >= 0) and (L <= 255) then
  begin
    CustomVideoMode := L;
    SaveRestore := RestoreVideoMode;
    RestoreVideoMode := True;
    UpdateScreen(StartupMode);
    RestoreVideoMode := SaveRestore;
  end
  else InvalidVMMsgBox;
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessXMDirective;
begin
  B := P + 4;
  FindClosingArrow;
  Val(Copy(CS, B, E - B), L, Code);
  if (Code = 0) and (L >= 0) and (L <= 255) then XVideoMode := L
  else InvalidVMMsgBox;
  Name := '';
  ReplaceText(E - P + 1);
end;

procedure ProcessXXDirective(const Directive: String);
var
  View, Ok: Boolean;
  Event: TEvent;
  R, SaveR: TExecRec;
begin
  if XXRecur then
  begin
    MessageBox(^C'Invalid use of the directive'#13 +
      ^C'$' + Directive + '.', nil, mfError + mfOkButton);
    XXRecur := False;
    Cancel := True;
    Exit;
  end;
  View := Directive[2] = 'W';
  B := P + Length(Directive) + 2;
  FindClosingArrow;
  S := Copy(CS, B, E - B);
  XXNamePtr := @S;
  Ok := ExtractExecRec(R, JustFileName(S), 0, View);
  if View and not Ok then
  begin
    FillChar(R, SizeOf(TExecRec), 0);
    R.Path := '$VIEW';
    Ok := True;
  end;
  if Ok then
  begin
    Name := '';
    ReplaceText(E - P + 1);
    SaveR := ExecRec;
    ExecRec := R;
    PrepareExecEvent;
    XXRecur := True;
    while Pending.What <> evNothing do
    begin
      Event := Pending;
      Pending.What := evNothing;
      Application^.HandleEvent(Event);
    end;
    XXRecur := False;
    ExecRec := SaveR;
  end
  else Cancel := True;
  XXNamePtr := nil;
end;

procedure ProcessDirective;
var
  I: Integer;
begin
  for I := edFirst to edLast do
  begin
    B := FIPos(Directives[I], ES, P);
    if B = P + 1 then
    begin
      case I of
        edARC, edDBASE, edEDIT, edHELP, edHTML, edICON,
        edMenu, edPANEL, edPRINT, edVIEW, edXEDIT, edXVIEW:
          ProcessOpenDirective(Directives[I]);
        edCN:
          ProcessCNDirective;
	edDAY, edMONTH, edYEAR, edFYEAR, edHOUR, edMIN, edSEC, edMSEC:
	  ProcessDateTimeDirective(I);
        edDIRARC:
          ProcessDIRARCDirective;
        edENV:
          ProcessENVDirective;
        edERR:
          ProcessFLAGDirective(Directives[I], opStdError);
        edEXT, edLEXT:
          ProcessEXTDirective(Directives[I]);
        edFILTER:
          ProcessBLKDirective(Directives[I], evBroadcast, cmFilter);
        edFINDDIR, edFINDNAME:
          ProcessFINDNAMEDirective(Directives[I]);
        edFNAME, edLFNAME:
          ProcessFNAMEDirective(Directives[I]);
        edGET:
          ProcessGETDirective;
        edHIST:
          ProcessHISTDirective;
        edHREF:
          ProcessGETSTRDirective(Directives[I], cmHRef);
        edKBD:
          ProcessKBDDirective;
        edLEFT, edLLEFT:
          ProcessGETSTRDirective(Directives[I], cmGetLeftPath);
        edMAC:
          ProcessBLKDirective(Directives[I], evCommand, cmUserMacros);
        edMEM:
          ProcessMEMDirective;
        edMSG:
          ProcessMSGDirective;
        edNAME, edLNAME:
          ProcessNAMEDirective(Directives[I]);
        edNOMSGWIN, edNMW:
          ProcessFLAGDirective(Directives[I], opNoMsgWin);
        edNOREDRAW, edNRD:
          ProcessFLAGDirective(Directives[I], opNoRedraw);
        edNOREREAD, edNRR:
          ProcessFLAGDirective(Directives[I], opNoReread);
        edNTM:
          ProcessFLAGDirective(Directives[I], opNoXfer);
        edOEXT, edLOEXT:
          ProcessOEXTDirective(Directives[I]);
        edONAME, edLONAME:
          ProcessONAMEDirective(Directives[I]);
        edOPATH, edLOPATH:
          ProcessOPATHDirective(Directives[I]);
        edOPPOSITE, edLOPP:
          ProcessGETSTRDirective(Directives[I], cmGetOppositePath);
        edPATH, edLPATH:
          ProcessPATHDirective(Directives[I]);
        edPRG:
          ProcessBLKDirective(Directives[I], evCommand, cmUserPrograms);
        edPROMPT:
          ProcessPROMPTDirective;
        edPUT:
          ProcessPUTDirective;
        edRDBLK:
          ProcessBLKDirective(Directives[I], evBroadcast, cmCtrlKR);
        edREPORT:
          ProcessREPORTDirective;
        edRIGHT, edLRIGHT:
          ProcessGETSTRDirective(Directives[I], cmGetRightPath);
        edSAMEWIN:
          ProcessFLAGDirective(Directives[I], opInfoBit);
        edSEL, edLSEL:
          ProcessSELDirective(Directives[I]);
        edSET: ProcessSETDirective;
        edSWAPDIR:
          ProcessSWAPDIRDirective;
        edUSERSCR, edUSR:
          ProcessFLAGDirective(Directives[I], opUserScr);
        edVM:
          ProcessVMDirective;
        edWORD:
          ProcessGETSTRDirective(Directives[I], cmGetWord);
        edWRBLK:
          ProcessBLKDirective(Directives[I], evBroadcast, cmCtrlKW);
        edXM:
          ProcessXMDirective;
        edXW, edXX:
          ProcessXXDirective(Directives[I]);
      end;
      Break;
    end;
  end;
end;

procedure StuffKey;
const
  KbdStart = $1E;
  KbdEnd = $3C;
var
  KbdHead: Word absolute $40:$1A;
  KbdTail: Word absolute $40:$1C;
  SaveKbdTail: Word;
begin
  SaveKbdTail := KbdTail;
  if KbdTail = KbdEnd then KbdTail := KbdStart
  else Inc(KbdTail, 2);
  if KbdTail = KbdHead then KbdTail := SaveKbdTail
  else MemW[$40:SaveKbdTail] := Keys[B];
end;

begin
  ValidateParams := False;
  Cancel := False;
  CS := Params;
  ConvertExecStr(Params, ES);
  K := MaxKeys;
  P := Length(ES);
  while P <> 0 do
  begin
    if ES[P] = '$' then
    begin
      ProcessDirective;
      if Cancel then Exit;
    end;
    Dec(P);
  end;
  Params := Trim(CS);
  for B := K to MaxKeys - 1 do StuffKey;
  ValidateParams := True;
end;

procedure SetFullExecPath;
var
  P: Byte;
  Ext: ExtStr;
  Name: NameStr;
  Dir: DirStr;
  PathVar: String;

procedure CheckBAT;
begin
  if CompUCString(Ext, '.BAT') = Equal then
    ExecRec.Options := ExecRec.Options or opLoadCOMMANDCOM;
end;

function Exists(const FName: FNameStr): Boolean;
begin
  if ThisFileExists(FName) then
  begin
    ExecRec.Path := FName;
    FSplit(FName, Dir, Name, Ext);
    CheckBAT;
    Exists := True;
  end
  else Exists := False;
end;

function OneOfThreeExists: Boolean;
begin
  OneOfThreeExists := Exists(Dir + Name + '.COM') or
    Exists(Dir + Name + '.EXE') or Exists(Dir + Name + '.BAT');
end;

begin
  GetCurDir(0, PathVar);
  PathVar := AddedSlash(PathVar);
  if Pos(PathVar, ExecRec.Path) = 1 then
    Delete(ExecRec.Path, 1, Length(PathVar));
  P := Pos(' ', ExecRec.Path);
  if P <> 0 then
  begin
    ExecRec.Params :=
      Trim(Copy(ExecRec.Path, P + 1, 255)) + ' ' + ExecRec.Params;
    ExecRec.Path[0] := Char(P - 1);
  end;
  lGetShortFileName(ExecRec.Path, ExecRec.Path);
  if ExecRec.Options and opLoadCOMMANDCOM <> 0 then Exit;
  FSplit(ExecRec.Path, Dir, Name, Ext);
  if Dir <> '' then
  begin
    if Ext <> '' then CheckBAT
    else OneOfThreeExists;
    Exit;
  end;
  PathVar := ';' + GetEnv('PATH');
  while PathVar[Length(PathVar)] = ';' do Dec(PathVar[0]);
  repeat
    P := Pos(';', PathVar) - 1;
    Dir := Trim(Copy(PathVar, 1, P));
    Delete(PathVar, 1, P + 1);
    if Dir <> '' then Dir := AddedSlash(Dir);
    if Ext <> '' then
      if Exists(Dir + ExecRec.Path) then Exit else
    else if OneOfThreeExists then Exit;
  until PathVar = '';
end;

procedure PrepareExecEvent;
begin
  Pending.What := evCommand;
  Pending.Command := cmExecRec;
end;

function SpecialCharPos(C: Char; var S: String): Integer;
var
  I: Integer;
begin
  I := 1;
  while I <= Length(S) do
  begin
    if S[I] = C then
      if (I = Length(S)) or (S[I + 1] = C) then Delete(S, I, 1)
      else Break;
    Inc(I);
  end;
  if I > Length(S) then I := 0;
  SpecialCharPos := I;
end;

procedure CheckMultiExec;
var
  P: Integer;
  S: TDosStream;
  Name: FNameStr;
  R: TExecRec;
begin
  MultiExec := False;
  P := SpecialCharPos(';', ExecRec.Path);
  if P = 0 then Exit;
  R.Path := Trim(Copy(ExecRec.Path, 1, P - 1));
  ExecRec.Path := Trim(Copy(ExecRec.Path, P + 1, 255));
  P := SpecialCharPos(';', ExecRec.Params);
  if P <> 0 then
  begin
    R.Params := Trim(Copy(ExecRec.Params, 1, P - 1));
    ExecRec.Params := Trim(Copy(ExecRec.Params, P + 1, 255));
  end
  else
  begin
    R.Params := ExecRec.Params;
    ExecRec.Params := '';
  end;
  R.FileMask := ExecRec.FileMask;
  R.LineMask := ExecRec.LineMask;
  R.Main := ExecRec.Main;
  R.Setup := ExecRec.Setup;
  R.Options := ExecRec.Options;
  SetExecRecName(Name);
  S.Init(Name, stCreate);
  if S.Status = stOk then S.Write(ExecRec, SizeOf(TExecRec));
  S.Done;
  ExecRec := R;
  MultiExec := True;
end;

procedure LoadMultiExecRec;
var
  S: TDosStream;
  F: File;
  Name: FNameStr;
  R: TExecRec;
begin
  MultiExec := False;
  SetExecRecName(Name);
  S.Init(Name, stOpenRead);
  if S.Status = stOk then
  begin
    S.Read(ExecRec, SizeOf(TExecRec));
    Byte(MultiExec) := 2;
  end;
  S.Done;
  if MultiExec then
  begin
    Assign(F, Name);
    Erase(F);
    InOutRes := 0;
    PrepareExecEvent;
  end;
end;

procedure AddSpoolerItem;
var
  C: Boolean;
  I: Integer;
  P: PSpoolerRec;
  T: ConvertTable;
begin
  C := BinaryPrinting;
  I := UCPos('/B', ExecRec.Params);
  if I <> 0 then
  begin
    ExecRec.Params[0] := Char(I - 1);
    BinaryPrinting := True;
  end
  else BinaryPrinting := False;
  P := TheSpooler^.NewSource(ExecRec.Path);
  BinaryPrinting := C;
  if (P <> nil) and (ExecRec.Params <> '') then
  begin
    ReadConvertTable(T, ExecRec.Params, C);
    SetSpoolerXLAT(P, T);
  end;
end;

function PrepareExecPrim: Boolean;
var
  WriteToHistory: Boolean;
  OpenCommand: Word;
  OpenPtr: Pointer;
label
  CancelExec;
begin
  WriteToHistory := HistoryOpened;
  HistoryOpened := False;
  SourceMsgSent := smNot;
  ExecMem := 655560;
  CheckMultiExec;
  if not ValidateParams(ExecRec.Path) then Goto CancelExec;
  if not ValidateParams(ExecRec.Params) then Goto CancelExec;
  if ExecRec.Main >= mnArc then
  begin
    case ExecRec.Main of
      mnArc:   OpenCommand := cmOpenArchive;
      mnView:  OpenCommand := cmOpenTextViewer;
      mnXView: OpenCommand := cmOpenHexViewer;
      mnEdit:  OpenCommand := cmOpenASCII;
      mnXEdit: OpenCommand := cmOpenHex;
      mndBASE: OpenCommand := cmOpenDataViewer;
      mnIcon:  OpenCommand := cmLoadIcon;
      mnMenu:  OpenCommand := cmUserPrograms;
      mnPanel: OpenCommand := cmReadFileList;
      mnPrint: OpenCommand := cmPrint;
      mnHelp:  OpenCommand := cmHelp;
      mnHTML:  OpenCommand := cmOpenHTML;
      else     OpenCommand := 0;
    end;
    if ExecRec.Path = '' then OpenPtr := nil
    else OpenPtr := @ExecRec;
    if OpenCommand = cmLoadIcon then IconParams := @ExecRec.Params;
    if OpenCommand <> 0 then
      if OpenCommand = cmHelp then
      begin
        Pending.What := evCommand;
        Pending.Command := cmHelp;
        Pending.InfoPtr := OpenPtr;
      end
      else if OpenCommand = cmUserPrograms then UserMenuDlg(OpenPtr)
      else if OpenCommand = cmPrint then AddSpoolerItem
      else Message(Application, evCommand, OpenCommand, OpenPtr);
    if MultiExec then LoadMultiExecRec;
    Goto CancelExec;
  end;
  if (ExecRec.Path = '') and (ExecRec.Params = '') then
  begin
    if MultiExec then LoadMultiExecRec;
    Goto CancelExec;
  end;
  if (Length(ExecRec.Path) = 2) and
     (CompUCString(ExecRec.Path, 'CD') = Equal) and
     (ExecRec.Params <> '') then
  begin
    FailSysErrors := True;
    lChDir(ExecRec.Params);
    FailSysErrors := False;
    InOutRes := 0;
    if MultiExec then LoadMultiExecRec;
    Goto CancelExec;
  end;
  SetFullExecPath;
  if WriteToHistory then HistoryAdd(
    FPromptHistoryID, ExecRec.Path + ' ' + ExecRec.Params, True);
  ExecRec.Options := ExecRec.Options or opPrepared;
  if GlobalQuietExec then ExecRec.Options := ExecRec.Options or
    (opMessage + opNoRedraw + opNoReread + opNoMsgWin + opNoXfer);
  PrepareExecPrim := True;
  Exit;

CancelExec:
  CancelExecution;
  PrepareExecPrim := False;
end;

procedure CancelExecution;
begin
  Message(Application, evBroadcast, cmCancelExec, nil);
end;

procedure SaveMsgFilters;
var
  F: Text;
begin
  if Byte(MultiExec) > 1 then Exit;
  Assign(F, ReportFile);
  Rewrite(F);
  if IOResult = 0 then
  begin
    if ExecRec.Options and opNoMsgWin = 0 then
    begin
      Writeln(F, ExecRec.FileMask);
      Writeln(F, ExecRec.LineMask);
    end;
    Close(F);
  end;
end;

end.
