editor.pas

Turbo Pascal 6.0编译器源码

function ErrorP(I: Integer): Boolean;
begin
  ErrorP := (I <> 0) and (I <> -2);
end;

function Rename(var S1, S2: PathStr): Integer;
begin
  if not FileExists(S1) then
    Rename := -2
  else
    Rename := FRename(S1, S2);
end;

begin
  SaveFile := False;
  P := @Editor^.FileRec^.FileName;
  if FileExists(P^) and (GetFileAttr(P^) and ReadOnly <> 0) then
  begin
    MessageBox(sReadOnly, ParamFile(P^), mfError + mfOkButton);
    Exit;
  end;
  TempFile := ForceExt(Editor^.FileRec^.FileName, '.$$$');
  Success := True;
  H := FOpen(TempFile, 3);
  if H >= 0 then
  begin
    SaveModified := EditData^.Modified;
    StatusLine^.PrintStr(sSaving, @P);
    if DoFunc1(edWriteFile, Pointer(H)) < 0 then
    begin
      FClose(H);
      FDelete(TempFile);
      MessageBox(sDiskFull, nil, mfError + mfOkButton);
    end else
    begin
      if Editor^.FileRec^.Time <> -1 then
        SetFTime(H, Editor^.FileRec^.Time);
      FClose(H);
      if BackupFiles then
      begin
        BakFile := ForceExt(Editor^.FileRec^.FileName, '.BAK');
        if ErrorP(FDelete(BakFile)) or
          ErrorP(Rename(Editor^.FileRec^.FileName, BakFile)) then
        begin
          MessageBox(sUnableBackup, ParamFile(P^), mfWarning + mfOkButton);
          Success := not ErrorP(FDelete(Editor^.FileRec^.FileName));
        end;
      end else
        Success := not ErrorP(FDelete(Editor^.FileRec^.FileName));
      if not Success or (Rename(TempFile,Editor^.FileRec^.FileName) <> 0) then
      begin
        MessageBox(sCantCreate, ParamFile(P^), mfError + mfOkButton);
        FDelete(TempFile);
        EditData^.Modified := SaveModified;
        Exit;
      end;
      Indicator^.SetValue(Editor^.CursorPos, False);
      SaveFile := True;
    end;
  end else MessageBox(sCantCreate, ParamFile(P^), mfError + mfOkButton);
end;

procedure TEditView.SearchFailure(var S: TSearchStr);
begin
  MessageBox(sStringNotFound, nil, mfError + mfOkButton);
end;

function TEditView.SearchDialog(var S: TSearchStr; var Opts: Word): Boolean;
const
  R: record
    S: TSearchStr;
    Opts: Word;
    Direction: Word;
    Scope: Word;
    Origin: Word;
  end = (S: ''; Opts: 0; Direction: 0; Scope: 0; Origin: 1);
var
  I: Word;
begin
  R.S := '';
  I := ExecDialog('FindDialog', @R);
  if I <> cmCancel then
  begin
    S := R.S;
    Opts := 0;
    if R.Opts and 1 = 0 then
      Inc(Opts, esIgnoreCase);
    if R.Opts and 2 <> 0 then
      Inc(Opts, esWholeWordsOnly);
    if R.Opts and 4 <> 0 then
      Inc(Opts, esRegularExprs);
    if R.Direction <> 0 then
      Inc(Opts, esBackward);
    if R.Scope <> 0 then
      Inc(Opts, esSelectedText);
    if R.Origin <> 0 then
      Inc(Opts, esEntireScope);
    SearchDialog := True;
  end else
    SearchDialog := False;
end;

procedure TEditView.SearchReplace(var S1, S2: TSearchStr; var Opts: Word);
var
  R: record
    Opts: Word;
    S: TSearchStr;
  end;
  Cont: Boolean;

function OK: Boolean;
var
  I: Word;
begin
  I := CanReplace;
  if I = cmCancel then
    Cont := False;
  OK := I = cmYes;
end;

begin
  R.Opts := Opts and not (esReplace + esNoPrompt + esChangeAll);
  repeat
    Cont := False;
    R.S := S1;
    if DoFunc1(edSearchText, @R) = 0 then
    begin
      CenterScreen;
      if Opts and esReplace <> 0 then
      begin
        if Opts and esChangeAll <> 0 then
          Cont := True;
        if (Opts and esNoPrompt <> 0) or OK then
        begin
          R.S := S2;
          DoFunc1(edReplaceText,@R);
        end;
      end;
    end else if Opts and esChangeAll = 0 then
    begin
      SearchFailure(S1);
      Cont := False;
    end;
    R.Opts := R.Opts and not esEntireScope;
  until not Cont;
  CenterScreen;
  Opts := Opts and not esEntireScope;
end;

procedure TEditView.SetColors;
var
  I: Integer;
begin
  with Editor^ do
  begin
    Colors[0] := GetColor(1);
    Colors[1] := GetColor(2);
    Colors[2] := GetColor(5);
    for I := 0 to 15 do
      FileRec^.Breakpoints.EBpt[I].Color := GetColor(4);
  end;
end;

procedure TEditView.SetPos(X, Y: Integer);
var
  I: Integer;
begin
  if (X > 0) and (Y > 0) and (Y <= TotalLines) then
    with Editor^ do
    begin
      TempPos.X := X;
      TempPos.Y := Y;
      DoFunc(edMoveToTempPos);
      CenterScreen;
    end;
end;

procedure TEditView.SetScrollBars;
begin
  HScrollBar^.SetParams(Editor^.CursorPos.X, 1, 128, Size.X, 1);
  VScrollBar^.SetParams(Editor^.CursorPos.Y, 1, TotalLines, Size.Y, 1);
end;

procedure TEditView.SetState(AState: Word; Enable: Boolean);

procedure DoShow(P: PView);
begin
  if Enable then
    P^.Show
  else
    P^.Hide;
end;

begin
  TView.SetState(AState, Enable);
  case AState of
    sfActive:
      begin
        Update;
        DoShow(HScrollBar);
        DoShow(VScrollBar);
        DoShow(Indicator);
        if Enable then
          EnableCommands(EditCommands)
        else
          DisableCommands(EditCommands2);
      end;
    sfExposed:
      SetColors;
  end;
end;

procedure TEditView.Store(var S: TStream);
begin
  TView.Store(S);
  PutPeerViewPtr(S, HScrollBar);
  PutPeerViewPtr(S, VScrollBar);
  PutPeerViewPtr(S, Indicator);
  S.Write(Editor^.FileRec^.FileName, Length(Editor^.FileRec^.FileName) + 1);
  S.Write(Editor^.ScreenPos, 19 * SizeOf(TPoint));
  S.Write(Editor^.Options, SizeOf(Word));
end;

procedure TEditView.ToggleBpt;
var
  I: Integer;
  B: TBreakpoint;
begin
  with Editor^ do
  begin
    SetBpt(B);
    I := FindBpt(B);
    if I < BptCount then
      DeleteBpt(I)
    else
      Tracer.SetBpt(I, B);
  end;
  ConnectAllBpts;
end;

function TEditView.TotalLines: Integer;
begin
  TotalLines := DoFunc(edGetTotalLines);
end;

procedure TEditView.Update;
var
  I: Word;
begin
  with Editor^ do
  begin
    HScrollBar^.SetValue(ScreenPos.X);
    VScrollBar^.SetValue(ScreenPos.Y);
    Indicator^.SetValue(CursorPos, EditData^.Modified and emShow <> 0);
    UpdateCommands;
    I := EditData^.Modified;
    if I and emUpdate <> 0 then
    begin
      EditData^.Modified := I and not emUpdate;
      FileRec^.Time := GetDateTime;
      Editor2Bpts(FileRec);
      VScrollBar^.SetRange(1, TotalLines);
      SourceModified := 1;
    end;
  end;
end;

procedure TEditView.UpdateCommands;
var
  T: TCommandSet;
begin
  if State and sfActive <> 0 then
  begin
    GetCommands(T);
    ChangeSet(T, cmCut, BlockSet);
    ChangeSet(T, cmCopy, BlockSet);
    ChangeSet(T, cmClear, BlockSet);
    ChangeSet(T, cmPaste, Clipboard^.BlockSet);
    ChangeSet(T, cmRestoreLine, CanRestore);
    SetCommands(T);
  end;
end;

procedure TEditView.UpdateFrame;
begin
  PWindow(Owner)^.Frame^.DrawView;
end;

function TEditView.Valid(Command: Word): Boolean;
var
  L: array[0..0] of Longint;
  S: TTitleStr;
begin
  if IsValid then
  begin
    Valid := True;
    if (Command <> cmValid) and Modified and
      ((Editor^.FileRec^.Editor^.Next = nil) or (Command = cmQuit)) then
    begin
      S := PWindow(Owner)^.GetTitle(36);
      L[0] := Longint(@S);
      case MessageBox(sFileModified, @L, mfInformation + mfYesNoCancel) of
        cmYes:
          Valid := Save;
        cmNo:
          ClearModifiedFlag;
        cmCancel:
          Valid := False;
      end;
    end;
  end else
    Valid := False;
end;

constructor TClipboard.Init(var Bounds: TRect;
  AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator);
begin
  TEditView.Init(Bounds, AHScrollBar, AVScrollBar, AIndicator, ClipName);
  EventMask := EventMask and not evEditor;
  Clipboard := @Self;
end;

constructor TClipboard.Load(var S:TStream);
begin
  TEditView.Load(S);
  Clipboard := @Self;
end;

procedure TClipboard.CopyToClip;
const
  CR: array[0..1] of Char = ^M#0;
var
  SaveCursorPos, SaveScreenPos: TPoint;
begin
  with Editor^ do
  begin
    SaveCursorPos := CursorPos;
    SaveScreenPos.Y := ScreenPos.Y;
    SaveScreenPos.X := ScreenPos.X;
    DoFunc(edEndCursorRaw);
  end;
  if Editor^.CursorPos.X <> 1 then
    DoFunc1(edInsertBuf, @CR);
  DoFunc1(edReadBlk, Pointer(hVMem));
  with Editor^ do
  begin
    CursorPos := SaveCursorPos;
    ScreenPos.Y := SaveScreenPos.Y;
    ScreenPos.X := SaveScreenPos.X;
  end;
  Repaint;
end;

function TClipboard.GetHelpCtx: Word;
begin
  GetHelpCtx := hcClipboard;
end;

procedure TClipboard.HandleEvent(var Event: TEvent);
begin
  case Event.What of
    evCommand:
      if Event.Command = cmClose then
      begin
        Owner^.Hide;
        ClearEvent(Event);
      end;
  end;
  TEditView.HandleEvent(Event);
end;

function TClipboard.SaveAs: Boolean;
begin
  SaveAs := TEditView.SaveAs;
  ChangeName(ClipName);
end;

procedure TClipboard.SetState(AState: Word; Enable: Boolean);
begin
  TEditView.SetState(AState, Enable);
  if Enable and (AState and sfActive <> 0) then
    DisableCommands(NoClipCommands);
end;

procedure TClipboard.UpdateFrame;
begin
end;

function TClipboard.Valid(Command: Word): Boolean;
begin
  Valid := True;
end;

constructor TEditWindow.Init(var Bounds: TRect; AName: PString;
  ANumber: Integer);
var
  HScrollBar, VScrollBar: PScrollBar;
  Indicator: PIndicator;
  Extent, R: TRect;
  S: string[25];
begin
  if AName = nil then
    S := Strings^.Get(sClipboard)
  else
    S := '';
  TTurboWindow.Init(Bounds, S, ANumber, wpEditWindow);
  GetExtent(Extent);
  R.Assign(Extent.A.X + 18, Extent.B.Y - 1, Extent.B.X - 2, Extent.B.Y);
  HScrollBar := New(PScrollBar, Init(R));
  HScrollBar^.Hide;
  Insert(HScrollBar);
  R.Assign(Extent.B.X - 1, Extent.A.Y + 1, Extent.B.X, Extent.B.Y - 1);
  VScrollBar := New(PScrollBar, Init(R));
  VScrollBar^.Hide;
  Insert(VScrollBar);
  R.Assign(Extent.A.X + 2, Extent.B.Y - 1, Extent.A.X + 16, Extent.B.Y);
  Indicator := New(PIndicator, Init(R));
  Indicator^.Hide;
  Insert(Indicator);
  Extent.Grow(-1, -1);
  if AName = nil then
    EditView := New(PClipboard, Init(Extent, HScrollBar, VScrollBar, Indicator))
  else
  begin
    EditView := New(PEditView, Init(Extent, HScrollBar, VScrollBar, Indicator, AName^));
    HelpCtx := hcEditWindow;
  end;
  Options := Options or ofTileable;
  Insert(EditView);
end;

constructor TEditWindow.Load(var S: TStream);
begin
  TTurboWindow.Load(S);
  GetSubViewPtr(S, EditView);
end;

function TEditWindow.GetTitle(MaxSize: Integer): TTitleStr;
var
  S: PathStr;
begin
  if Title <> nil then
    GetTitle := Title^
  else if EditView = nil then
    GetTitle := ''
  else
  begin
    S := EditView^.Editor^.FileRec^.FileName;
    ConvertPath(S, MaxSize);
    GetTitle := S;
  end;
end;

procedure TEditWindow.Store(var S: TStream);
begin
  TTurboWindow.Store(S);
  PutSubViewPtr(S, EditView);
end;

function FindEditor(P: PString): PEditView;
begin
  FindEditor := Message(Desktop, evEditor, cmFindEditor, P);
end;

procedure TopmostName(var S: PathStr);
var
  P: PEditView;
begin
  P := FindEditor(nil);
  if P <> nil then
    S := P^.Editor^.FileRec^.FileName
  else
    S := '';
end;

function CreateEditor(var S: PathStr; Replace, NoTop: Boolean): PEditView;
var
  W: PEditWindow;
  V: PEditView;
  Event: TEvent;
  P: PView;
  Min, Max: TPoint;
  R, Topmost, Extent: TRect;
begin
  CreateEditor := nil;
  V := FindEditor(nil);
  if V = nil then
    Replace := False
  else if V^.Noname and (V^.TotalLines = 0) then
    Replace := not Unnamed(S);
  if Replace then
  begin
    if not V^.Valid(cmQuit) then
      Exit
    else
    begin
      V^.EditNewFile(S);
      CreateEditor := V
    end;
  end else
  begin
    Desktop^.GetExtent(Extent);
    Event.What := evBroadcast;
    Event.Command := cmFindBottomLimit;
    Event.InfoInt := Extent.B.Y;
    Desktop^.HandleEvent(Event);
    if Event.InfoInt - Extent.A.Y >= MinWinSize.Y then
      Extent.B.Y := Event.InfoInt;
    R := Extent;
    if V <> nil then
    begin
      V^.Owner^.GetBounds(Topmost);
      Inc(Topmost.A.X);
      Inc(Topmost.A.Y);
      V^.Owner^.SizeLimits(Min,Max);
      if Topmost.B.X - Topmost.A.X < Min.X then
        Topmost.B.X := Topmost.A.X + Min.X;
      if Topmost.B.Y - Topmost.A.Y < Min.Y then
        Topmost.B.Y := Topmost.A.Y + Min.Y;
      R.Intersect(Topmost);
      if not R.Equals(Topmost) then
        R := Extent;
    end;
    W := PEditWindow(ValidView(New(PEditWindow, Init(R, @S, GetFreeWNum))));
    if W <> nil then
    begin
      if NoTop and (V <> nil) then
        P := V^.Owner
      else
        P := Desktop^.First;
      Desktop^.InsertBefore(W, P);
      CreateEditor := W^.EditView;
    end;
  end;
end;

function OpenFile(var S: PathStr; NoTop: Boolean): PEditView;
var
  P: PEditView;
  V: PView;
begin
  P := FindEditor(@S);
  if P <> nil then
  begin
    if NoTop then
      V := FindEditor(nil)^.Owner
    else
      V := Desktop^.First;
    P^.Owner^.PutInFrontOf(V);
  end else if FileExists(S) then
    P := CreateEditor(S, Preferences.SourceTracking <> 0, NoTop);
  OpenFile := P;
end;

function GoFileLine(S: PathStr; I: Integer; Options: Byte): Boolean;
var
  P: PEditView;
  L: array[0..1] of Longint;
type
  PLong = ^Longint;
begin
  P := OpenFile(S, Options and gfNoTop <> 0);
  if P <> nil then
  begin
    if Options and gfProgram <> 0 then
      P^.GotoOldLine(I, Options and gfExec <> 0)
    else
      P^.SetPos(1, I);
    GoFileLine := True
  end else
  begin
    if Options and gfAlways <> 0 then
    begin
      L[0] := PLong(ParamFile(S))^;
      L[1] := I;
      MessageBox(sCantFindSource, @L, mfError + mfOkButton);
    end;
    GoFileLine := False;
  end;
end;

procedure SetOptions;

procedure DoSetOptions(P: PEditor); far;
begin
  P^.Options := P^.Options and not ChangingOptions or
    DefOptions and ChangingOptions;
  P^.TabSize := DefTabSize;
  P^.EditView^.SetState(sfCursorIns, DefOptions and eoOverwrite <> 0);
  P^.EditView^.DrawView;
end;

begin
  ForEachEditor(@DoSetOptions);
end;

end.