{$I-,F+,O+,X+}
unit FMAction;

interface

uses Objects, Drivers, ProgList, FileMngr;

procedure GetExecRecPrim(FManager: PPanel; var Rec: TExecRec);
procedure TreeItemSelectedPrim(FManager: PPanel; Item: Integer);
procedure ItemSelectedPrim(FManager: PPanel; Item: Integer);
procedure FMOpenPrim(FManager: PPanel; ACommand: Word);
procedure GetDirViewLines(FManager: PPanel; const S: FNameStr;
  NumFiles, FilesSize, NumBytes,
  NumTagged, TaggedSize, TaggedBytes: Longint;
  var DirS, NumFilesS, FilesS, NumTaggedS, TaggedS: FNameStr);
procedure FMViewPrim(FManager: PPanel; ACommand: Word);
procedure FMViewNextPrim(FManager: PPanel; var Event: TEvent);
function AreDirs(FManager: PPanel; Single: Boolean): Boolean;
procedure AppendSelListPrim(FManager: PPanel;
  const	Name, Mask, Fmt: FNameStr;
  Long, Full, SelOnly: Boolean);

implementation

uses Dos, Views, Memory, App, MsgBox, PanelRec, DirPrim, DiskPrim, ExecPrim,
  Archives, History, FMAbort, FMBBS, FMDialog, FMInfo, FMList, FMSecond,
  Tags, EditMsg, LFN, Keyboard, DosTools, TPString, Consts, Commands,
  Defaults;

procedure GetExecRecPrim(FManager: PPanel; var Rec: TExecRec);
var
  Key: Word;
  SR: PPanelRec;
  Ext: String[3];
  Name:	FNameStr;
begin
  with FManager^ do
  begin
    SR := PPanelRec(List^.At(Focused));
    AddNameExt('', SR, Name);
    Key	:= GetShiftState;
    if Key and kbAltShift <> 0 then Key	:= 1
    else if Key	and (kbLeftShift + kbRightShift) <> 0 then Key := 2
    else Key :=	0;
    if ExtractExecRec(Rec, Name, Key, False) then Exit;
    FillChar(Rec, SizeOf(TExecRec), 0);
    Ext	:= StUpcase(SR^.Ext);
    if (Ext <> 'BAT') and (Ext <> 'COM') and (Ext <> 'EXE') then Exit;
    GetSource(Rec.Path);
    Move(Main, Rec.Main, SizeOf(Word) *	3);
  end;
end;

procedure TreeItemSelectedPrim(FManager: PPanel; Item: Integer);
var
  SameArchive: Boolean;
  SaveState: Word;
  S: FNameStr;
begin
  with FManager^ do
  begin
    S := TheTree^.GetDirStr(Item);
    if not InArchive then Message(Owner, evBroadcast, cmNewPrompt, @S);
    if Opposite^.Status	<> stTree then
    begin
      Opposite^.Options	:= Opposite^.Options and not ofValidate;
      if Opposite^.InArchive then
      begin
	SameArchive := InArchive and
	  (Archiver^.ArcName^ =	Opposite^.Archiver^.ArcName^);
	if not SameArchive then
	begin
	  Dispose(Opposite^.Archiver, Done);
	  Opposite^.InArchive := False;
	end;
      end
      else SameArchive := False;
      SaveState	:= Owner^.State;
      Owner^.State := Owner^.State and not sfSearching;
      if InArchive and not SameArchive then IntoArchive(
	Opposite, AddedSlash(S), Length(Archiver^.ArcName^))
      else
      begin
	if SameArchive then
	begin
	  Opposite^.Archiver^.NewArcDir(S);
	  Opposite^.NewDir(Opposite^.ListDir^, True);
	end
	else Opposite^.NewDir(S, True);
	Opposite^.FocusItem(0);
      end;
      Owner^.State := SaveState;
      if Opposite^.State and sfVisible = 0 then
	TogglePanelPrim(PPanelWindow(Owner), Opposite, tmByF);
    end;
    DrawView;
  end;
end;

procedure ItemSelectedPrim(FManager: PPanel; Item: Integer);
var
  I: Integer;
  SR: PPanelRec;
  S, NS: String;

procedure MoveAroundInArchive;
var
  A: Pointer;
begin
  with FManager^ do
  begin
    if SR^.Name[1] <> '.' then
      if SR^.Attr and VolumeID <> 0 then
      begin
	Archiver^.GetDownOrUpName(SR^.Name[1] =	'N', NS);
	if NS <> '' then Archiver^.NewArchive(NS, '');
      end
      else
      begin
	AddNameExt(S + '\', SR,	NS);
	Archiver^.NewArcDir(NS);
      end
    else if CompUCString(Archiver^.ArcName^, S) = Equal then
    begin
      A	:= Archiver^.Prev;
      Archiver^.Prev :=	nil;
      Dispose(Archiver,	Done);
      Archiver := A;
      InArchive	:= A <>	nil;
    end
    else Archiver^.NewArcDir(PrevDir(S));
    NewDir(ListDir^, True);
    GetItemNum(S, I);
    FocusItem(I);
  end;
end;

begin
  with FManager^ do
  begin
    if (List^.Count = 0) or (Status >= stInfo) then Exit;
    if Status =	stTree then
    begin
      TreeItemSelectedPrim(FManager, Item);
      Exit;
    end;
    SR := List^.At(Item);
    if SR^.Attr	and Directory <> 0 then
    begin
      if not InArchive and
	(SR^.Attr and VolumeID <> 0) and
	(Settings and seList <> 0) then
      begin
	OutOfFileListPrim(FManager);
	Exit;
      end;
      if Options and ofValidate	<> 0 then
      begin
	if (SR^.Name[0]	= #2) and (SR^.Name[2] = ':') then
	  SelectDrivePrim(FManager, SR^.Name[1], False)
	else if	SR^.ThePath <> nil then
	begin
	  Options := Options and not ofValidate;
	  NewDir(PanelRecPath(SR), True);
	  FocusItem(0);
	end;
	Exit;
      end;
      if SR^.Name[1] = ':' then
      begin
	DrivePanel;
	Exit;
      end;
      GetListDir(S);
      if InArchive then
      begin
	MoveAroundInArchive;
	Exit;
      end;
      if SR^.Name[1] <>	'.' then AddNameExt(S +	'\', SR, NS)
      else NS := PrevDir(S);
      NewDir(NS, True);
      if UCPos(NS, S) <> 0 then GetItemNum(S, I)
      else I :=	0;
      FocusItem(I);
    end
    else
    begin
      GetExecRecPrim(FManager, ExecRec);
      if ExecRec.Path <> '' then
      begin
	PPanelWindow(Owner)^.PromptLine^.HistCount := $FF;
	HistoryOpened := True;
	PrepareExecEvent;
      end;
    end;
  end;
end;

procedure FMOpenPrim(FManager: PPanel; ACommand: Word);
var
  Command: Word;
  I: Integer;
  SR: PPanelRec;
  S: String;

function FileSelected: Boolean;
var
  I: Integer;
begin
  with FManager^ do
  begin
    FileSelected := False;
    if (List^.Count = 0) or (SelCount = 0) or (Status >= stTree) then Exit;
    for I := 0 to List^.Count - 1 do
    begin
      SR := List^.At(I);
      if (SR^.Attr and Directory = 0) and SR^.Selected then
      begin
	FileSelected := True;
	Exit;
      end;
    end;
  end;
end;

begin
  with FManager^ do
  begin
    if Status =	stQuickView then
    begin
      if Opposite^.Status in [stQuickView, stQuickDescr] then Exit;
      FMOpenPrim(Opposite, ACommand);
      Exit;
    end;
    if Status =	stQuickDescr then
    begin
      if Opposite^.Status in [stQuickView, stQuickDescr] then Exit;
      EditFilesBBSPrim(Opposite);
      Exit;
    end;
    if InArchive or ((List^.Count = 0) and (Status < stInfo)) or
       (Status = stTree) then Exit;
    if ACommand	= cmIsHex then Command := cmOpenHex
    else Command := cmOpenASCII;
    if Status =	stInfo then
    begin
      Opposite^.GetListDir(S);
      Inc(S[0]);
      S[Length(S)] := '\';
      SetFirstFoundName(DirinfoNames, S);
      if S <> '' then Message(Application, evCommand, Command, @S);
    end
    else if (SelCount >	0) and (Settings and seIgnoreSelection = 0) and
      (FMOptions and foOpenFocused = 0) and FileSelected then
    begin
      DoneSelList;
      InitSelList;
      I	:= 0;
      CancelSysErrors := False;
      EditorAborted := False;
      while (I < List^.Count) and not CancelSysErrors
	and not	EditorAborted and not LowMemory	do
      begin
	SR := List^.At(I);
	if (SR^.Attr and Directory = 0)	and SR^.Selected then
	begin
	  GetRecStr(SR,	S);
	  Message(Application, evCommand, Command, @S);
	  SetSelect(SR,	False);
	  if FMOptions and foUnsel <> 0	then FocusItem(Focused);
	end;
	Inc(I);
      end;
    end
    else
    begin
      SR := List^.At(Focused);
      if SR^.Attr and Directory	= 0 then
      begin
	GetRecStr(SR, S);
	Message(Application, evCommand,	Command, @S);
      end;
    end;
  end;
end;

procedure AddByteStr(var S: String);
begin
  if S[Length(S)] = 'K'	then S := S + 'B'
  else S := S +	' bytes';
end;

procedure GetDirViewLines(FManager: PPanel; const S: FNameStr;
  NumFiles, FilesSize, NumBytes,
  NumTagged, TaggedSize, TaggedBytes: Longint;
  var DirS, NumFilesS, FilesS, NumTaggedS, TaggedS: FNameStr);
var
  SS: FNameStr;
begin
  with FManager^ do
    if InArchive and (Archiver^.ArcName^ = S) then
      SS := 'Archive:    ' else	SS := 'Directory:  ';
  DirS := SS + TrimmedName(S, 22);
  FormatBytes(NumFilesS, NumFiles, MaxLongint);
  FormatBytes(SS, FilesSize, 10000000);
  FormatBytes(FilesS, NumBytes,	10000000);
  AddByteStr(SS);
  SS :=	' (' + SS + ')';
  if FilesSize = 1 then	Delete(SS, Length(SS) -	1, 1);
  NumFilesS := 'Files:      ' +	NumFilesS + SS;
  AddByteStr(FilesS);
  FilesS := 'Total size: ' + FilesS;

  FormatBytes(NumTaggedS, NumTagged, MaxLongint);
  FormatBytes(SS, TaggedSize, 10000000);
  FormatBytes(TaggedS, TaggedBytes, 10000000);
  AddByteStr(SS);
  SS :=	' (' + SS + ')';
  if TaggedSize	= 1 then Delete(SS, Length(SS) - 1, 1);
  NumTaggedS :=	'Selected:   ' + NumTaggedS + SS;
  AddByteStr(TaggedS);
  TaggedS := 'Total size: ' + TaggedS;
end;

procedure FMViewPrim(FManager: PPanel; ACommand: Word);
var
  DoExec: Boolean;
  Key: Word;
  LoY, HiY: Integer;
  SR: PPanelRec;
  NumF,	NumS, NumB, NumSel, SelS, SelB:	Longint;
  R: TRect;
  S, DS, FS, BS, TS, TB, BF: FNameStr;
begin
  with FManager^ do
  begin
    if Status in [stQuickView, stQuickDescr] then
    begin
      if Opposite^.Status in [stQuickView, stQuickDescr] then Exit;
      FMViewPrim(Opposite, ACommand);
      Exit;
    end;
    if (List^.Count = 0) or (Status = stInfo) then Exit;
    SR := PPanelRec(List^.At(Focused));
    if SR^.Attr	and Directory <> 0 then
    begin
      GetRecStr(SR, S);
      if InArchive then
      begin
	if (SR^.Attr and VolumeID <> 0)	and
	   (SR^.Name[1]	<> '.')	then Exit;
	if not Archiver^.GetDirInfo(S, NumF, NumS, NumB,
	  NumSel, SelS,	SelB, TagList^.Count <>	0) then	Exit;
      end
      else if not GetDirInfo(S,	NumF, NumS, NumB, NumSel, SelS,	SelB,
	TagList^.Count <> 0, Settings and seList = 0, False) then Exit;
      if (Settings and seCalcDirSize <>	0) and not InArchive then
	ReReadPrim(True);
      GetDirViewLines(FManager,	S,
	NumF, NumS, NumB, NumSel, SelS,	SelB,
	DS, FS,	BS, TS,	TB);

      if InArchive or (ListDir^[1] = '\') then BF := ''
      else
      begin
	FormatFloatBytes(BF, BytesFree, 1000000000);
	AddByteStr(BF);
	BF := 'Free space: ' + BF;
      end;

      S	:= Concat(DS, #13, FS, #13, BS);
      if TagList^.Count	<> 0 then S := Concat(S, #13#13, TS, #13, TB);
      if BF <> '' then S := Concat(S, #13#13, BF);

      LoY := ScreenHeight div 2	- 5;
      HiY := ScreenHeight div 2	+ 4;
      if TagList^.Count	<> 0 then
      begin
	Dec(LoY);
	Inc(HiY, 2);
      end;
      if BF <> '' then
      begin
	Dec(LoY);
	Inc(HiY);
      end;

      R.Assign(ScreenWidth div 2 - 20, LoY, ScreenWidth	div 2 +	20, HiY);
      CtxMessageBoxRect(R, S, nil, mfInformation + mfOkButton, hcDirSizes);
    end
    else with ExecRec do
    begin
      Params :=	'';
      Options := 0;
      if ACommand = cmFCtrlView	then Path := '$XVIEW'
      else
      begin
	Key := ACommand	- cmFView;
	AddNameExt('', SR, S);
	if not ExtractExecRec(ExecRec, S, Key, True) then
	begin
	  if Path = #0 then Exit;
	  Path := '$VIEW';
	end;
      end;
      PrepareExecEvent;
    end;
  end;
end;

procedure FMViewNextPrim(FManager: PPanel; var Event: TEvent);
var
  ShiftDown: Boolean;
  I, J: Integer;
  SR: PPanelRec;
  S: String;
begin
  Event.What := evNothing;
  ShiftDown := GetShiftState and (kbLeftShift + kbRightShift) <> 0;
  with FManager^ do
  begin
    if InArchive then
    begin
      I := 0;
      FindByName(PString(Event.InfoPtr)^, I);
      if I = -1 then Exit;
    end
    else
    begin
      GetItemNum(PString(Event.InfoPtr)^, I);
      GetItemStr(I, S);
      if CompUCString(PString(Event.InfoPtr)^, S) <> Equal then Exit;
    end;
    J := I;
    if Event.Command = cmFMViewPrev then while I <> 0 do
    begin
      Dec(I);
      SR := List^.At(I);
      if (SR = nil) or (SR^.Attr and Directory = 0) then Break;
    end
    else while I < List^.Count do
    begin
      Inc(I);
      SR := List^.At(I);
      if (SR = nil) or (SR^.Attr and Directory = 0) then Break;
    end;
    if I = J then Exit;
    SR := List^.At(I);
    if (SR <> nil) and (SR^.Attr and Directory = 0) then
    begin
      FocusItem(I);
      GlobalRedrawLock := True;
      GlobalQuietExec := True;
      GetSource(S);
      GlobalRedrawLock := False;
      GlobalQuietExec := False;
      ExecRec.Path := '$VIEW(' + S + ')';
      if ShiftDown then ExecRec.Params := ''
      else ExecRec.Params := '$SAMEWIN';
      ExecRec.Options := 0;
      PrepareExecEvent;
    end;
  end;
end;

function AreDirs(FManager: PPanel; Single: Boolean): Boolean;
var
  I: Integer;
  SR: PPanelRec;
begin
  with FManager^ do
  begin
    if (SelCount <> 0) and not Single and
       (Settings and seIgnoreSelection = 0) then
      AreDirs := DirSelected
    else
    begin
      SR := List^.At(Focused);
      if SR^.Name = '..' then
      begin
        if Settings and seUnfold = 0 then
          for I := 0 to List^.Count - 1 do
          begin
            SR := List^.At(I);
	    if (SR^.Name[1] <> '.') and
               (SR^.Attr and Directory <> 0) then
            begin
              AreDirs := True;
              Exit;
            end;
          end;
        AreDirs := False;
      end
      else AreDirs := SR^.Attr and Directory <> 0;
    end;
  end;
end;

procedure AppendSelListPrim(FManager: PPanel;
  const	Name, Mask, Fmt: FNameStr;
  Long, Full, SelOnly: Boolean);
var
  Abort: Boolean;
  SaveStatus: Byte;
  I, ILo, IHi: Integer;
  P: PPanelRec;
  PName: PString;
  CurDir, FindPath, S: FNameStr;
  F: lText;

procedure WriteName;
begin
  if (FManager^.Settings and seList = 0) and not Long then
    lGetShortFileName(S, S);
  if not Full and (UCPos(CurDir, S) = 1) then
    System.Delete(S, 1, Length(CurDir));
  ProcessFmt(Fmt, S);
  Writeln(F.T, S);
  Abort	:= IOResult <> 0;
end;

procedure SetFindPath(const ADir: FNameStr);
begin
  FindPath := Concat(ADir, '\*.*');
end;

procedure SetCurPath(const ADir, AName:	FNameStr);
begin
  FindPath := Concat(ADir, '\',	AName);
end;

procedure SetNameStr(const ADir, AName:	FNameStr);
begin
  S := Concat(ADir, '\', AName);
end;

procedure ScanDir(ADir:	PString);
var
  SR: ^lSearchRec;
  Dir: PString;
begin
  if StackOverflow then
  begin
    Abort := True;
    Exit;
  end;
  Dir := NewStr(ADir^);
  GetMem(SR, SizeOf(lSearchRec));
  GiveTicks;
  SetFindPath(Dir^);
  FailSysErrors	:= True;
  lFindFirst(FindPath, $17, SR^);
  FailSysErrors	:= False;
  while	(DosError = 0) and not Abort do
  begin
    if SR^.SR.Attr and Directory = 0 then
    begin
      if SR^.FullName <> '' then PName := @SR^.FullName
      else PName := @SR^.SR.Name;
      if (Mask = '') or	WildCardMatch(PName^, Mask) then
      begin
	SetNameStr(Dir^, PName^);
	if FoundInCRCList(S, FManager^.CRCList)	then WriteName;
      end;
    end
    else if SR^.SR.Name[1] <> '.' then
    begin
      if SR^.FullName <> '' then SetCurPath(Dir^, SR^.FullName)
      else SetCurPath(Dir^, SR^.SR.Name);
      ScanDir(@FindPath);
    end;
    lFindNext(SR^);
    if (KbdStatus = 1) and FMAbortAction then Abort := True;
  end;
  lFindClose(SR^);
  FreeMem(SR, SizeOf(lSearchRec));
  DisposeStr(Dir);
end;

begin
  with FManager^ do
  begin
    LogEvent :=	lcDiskWrite;
    DrawStatusLine('Adding selected file names to ' +
      TrimmedName(Name,	37) + '.');
    lAssignText(F, Name);
    Append(F.T);
    if IOResult	<> 0 then Exit;
    GetCurDir(0, CurDir);
    CurDir := AddedSlash(CurDir);
    if not Long	then lGetShortFileName(CurDir, CurDir);
    SaveStatus := Status;
    if Status = stTree then Status := stBrief;
    Abort := False;
    if InArchive then Archiver^.SaveSelected(@F, Mask, '', Abort)
    else
    begin
      if not SelOnly and ((SelCount = 0) or
	(Settings and seIgnoreSelection <> 0)) then
      begin
	ILo := Focused;
	IHi := Focused;
      end
      else
      begin
	ILo := 0;
	IHi := List^.Count - 1;
	SelOnly := True;
      end;
      for I := ILo to IHi do
      begin
	P := List^.At(I);
	if not SelOnly or P^.Selected then
	begin
	  GetRecStr(P, S);
	  if P^.Attr and Directory <> 0 then ScanDir(@S)
	  else if (Mask = '') or WildCardMatch(JustFileName(S), Mask) then
	    WriteName;
	end;
	if Abort then Break;
      end;
    end;
    Status := SaveStatus;
    Close(F.T);
    InOutRes := 0;
  end;
end;

end.
