editor.pas

Turbo Pascal 6.0编译器源码

  ExitCode: Integer;
  Double: Boolean;
  First: Boolean;
  Expand: Boolean;
  LineSelDirection: Boolean;
  H, SaveModified: Integer;
  ShiftState: Byte absolute $40:$17;

procedure SetBegPoint;
begin
  DoFunc(edSetPrevPos);
  with Editor^ do
    if PrevPos.Y < BlockBeg.Y then
      P := BlockEnd
    else if PrevPos.Y > BlockEnd.Y then
      P := BlockBeg
    else if PrevPos.X < BlockBeg.X then
      P := BlockEnd
    else
      P := BlockBeg;
end;

procedure ExpandSel;
begin
  DoFunc(edSetPrevPos);
  with Editor^ do
    if PrevPos.Y < P.Y then
    begin
      BlockEnd := P;
      DoFunc(edSetBlockBegRaw);
    end else if PrevPos.Y > P.Y then
    begin
      BlockBeg := P;
      DoFunc(edSetBlockEndRaw);
    end else if PrevPos.X < P.X then
    begin
      BlockEnd := P;
      DoFunc(edSetBlockBegRaw);
    end else
    begin
      BlockBeg := P;
      DoFunc(edSetBlockEndRaw);
    end;
end;

procedure ExpandLineSel;
var
  SaveCursorPos: TPoint;
  Y: Integer;
begin
  with Editor^ do
  begin
    SaveCursorPos := CursorPos;
    Y := ScreenPos.Y;
    if P.Y < BlockEnd.Y then
    begin
      Inc(CursorPos.Y);
      DoFunc(edLeftOfLine);
      ExpandSel;
      if not LineSelDirection then
      begin
        CursorPos.Y := P.Y + 1;
        DoFunc(edLeftOfLine);
        ExpandSel;
        LineSelDirection := True;
      end;
    end else
    begin
      DoFunc(edLeftOfLine);
      ExpandSel;
      if LineSelDirection then
      begin
        CursorPos.Y := P.Y;
        DoFunc(edLeftOfLine);
        ExpandSel;
        LineSelDirection := False;
      end;
    end;
    CursorPos := SaveCursorPos;
    ScreenPos.Y := Y;
  end;
end;

procedure ProcessMouse;
var
  Q: TPoint;
  R: TRect;
begin
  GetExtent(R);
  Double := Event.Double;
  First := True;
  Expand := True;
  LineSelDirection := True;
  with Editor^ do
    repeat
      MakeLocal(Event.Where, Q);
      if R.Contains(Q) then
      begin
        CursorPos.X := Q.X + ScreenPos.X;
        CursorPos.Y := Q.Y + ScreenPos.Y;
        if First then
        begin
          First := False;
          Options := Options and not eoBlockHidden;
          if ShiftState and (kbRightShift + kbLeftShift) = 0 then
          begin
            if Double then
              DoFunc(edLeftOfLine);
            DoFunc(edSetBlockBegRaw);
            SetBegPoint;
            if Double then
              DoFunc(edCursorDown);
            DoFunc(edSetBlockEndRaw);
          end else
          begin
            SetBegPoint;
            ExpandSel
          end;
        end else if Double then
          ExpandLineSel
        else
          ExpandSel;
        Repaint;
      end else if Event.What = evMouseAuto then
      begin
        if Q.Y < 0 then
        begin
          CursorPos.Y := ScreenPos.Y;
          DoFunc(edCursorUp);
          Expand := True;
        end;
        if Q.Y >= Size.Y then
        begin
          CursorPos.Y := ScreenPos.Y + Size.Y - 1;
          DoFunc(edCursorDown);
          Expand := True;
        end;
        if Q.X < 0 then
        begin
          CursorPos.X := ScreenPos.X;
          DoFunc(edCursorSwitchedLeft);
          Expand := True;
        end;
        if Q.X >= Size.X then
        begin
          CursorPos.X := ScreenPos.X + Size.X - 1;
          DoFunc(edCursorSwitchedRight);
          Expand := True;
        end;
        if Expand then
        begin
          if Double then
            ExpandLineSel
          else
            ExpandSel;
          Repaint;
          Expand := False;
        end;
      end;
    until not MouseEvent(Event,evMouseMove + evMouseAuto);
end;

procedure ClearFoundBar;
begin
  if EditData^.SearchPos <> -1 then
  begin
    EditData^.SearchPos := -1;
    Repaint;
  end;
end;

procedure UpdateOptions(P: PEditor); far;
begin
  P^.Options := P^.Options and not ChangingOptions or
    DefOptions and ChangingOptions;
  if DefOptions and eoOverwrite <> 0 then
    P^.EditView^.BlockCursor
  else
    P^.EditView^.NormalCursor;
end;

procedure InsertCompOpt;
var S: string;
begin
  CompOptions(S);
  S[Length(S)+1] := #0;
  DoFunc1(edInsertBuf, @S[1]);
  DrawView;
end;

begin
  TView.HandleEvent(Event);
  case Event.What of
    evKeyDown:
      begin
        ClearFoundBar;
	if (Event.ScanCode in Arrows) and
	  (ShiftState and (kbRightShift + kbLeftShift) <> 0) then
        begin
          Event.CharCode := #0;
          if not Selecting then
          begin
            Editor^.Options := Editor^.Options and not eoBlockHidden;
            DoFunc(edSetBlockBegRaw);
            SetBegPoint;
            DoFunc(edSetBlockEndRaw);
            Selecting := True;
          end;
        end;
        ExitCode := DoFunc(Event.KeyCode);
        Update;
        case ExitCode of
          4:
            if SearchDialog(SearchStr, SearchOptions) then
            begin
              SearchReplace(SearchStr, ReplaceStr, SearchOptions);
              SearchAlready := True;
            end;
          5:
            if SearchAlready then
              SearchReplace(SearchStr,ReplaceStr,SearchOptions);
          6:
            if ReplaceDialog(SearchStr,ReplaceStr,SearchOptions) then
            begin
              SearchReplace(SearchStr,ReplaceStr,SearchOptions);
              SearchAlready := True;
            end;
          3:
            begin
              H := RwBlock(0);
              if H >= 0 then
              begin
                DoFunc1(edReadBlk, Pointer(H));
                FClose(H);
                Repaint;
              end;
            end;
          2:
            begin
              H := RwBlock(1);
              if H >= 0 then
              begin
                if DoFunc1(edWriteBlk, Pointer(H)) < 0 then
                  MessageBox(sDiskFull, nil, mfError + mfOkButton);
                FClose(H);
              end;
            end;
          18:
            Save;
          10:
            InsertCompOpt;
          11:
            begin
              SaveModified := EditData^.Modified;
              DoFunc1(edWriteBlk, Pointer(4));
              EditData^.Modified := SaveModified;
            end;
          20:
            begin
              Event.What := evCommand;
              Event.Command := cmLastError;
              PutEvent(Event);
            end;
          -1:
            Exit;
        else
          if ExitCode < 0 then
          begin
            Event.What := evCommand;
            Event.Command := ExitCode and $FF;
            Event.InfoPtr := nil;
            PutEvent(Event);
          end;
        end;
        if (Event.ScanCode in Arrows) and
          (ShiftState and (kbRightShift + kbLeftShift) <> 0) then
        begin
          if Selecting then
          begin
            ExpandSel;
            Repaint
          end
        end else
          Selecting:=False;
        with Editor^ do
          if DefOptions <> Options then
          begin
            DefOptions := Options;
            ForEachEditor(@UpdateOptions);
          end;
        ClearEvent(Event);
      end;
    evMouseDown:
      begin
        ClearFoundBar;
        ProcessMouse;
        ClearEvent(Event);
      end;
    evRightClick:
      if RBAction <> 0 then
      begin
        MakeLocal(Event.Where, Mouse);
        with Editor^ do
        begin
          CursorPos.X := Mouse.X + ScreenPos.X;
          CursorPos.Y := Mouse.Y + ScreenPos.Y;
        end;
        Repaint;
        Event.What := evCommand;
        Event.Command := RBActs[RBAction];
        PutEvent(Event);
        ClearEvent(Event);
      end;
    evCommand:
      begin
        case Event.Command of
          cmFind:
            if SearchDialog(SearchStr, SearchOptions) then
            begin
              SearchReplace(SearchStr, ReplaceStr, SearchOptions);
              SearchAlready := True;
            end;
          cmReplace:
            if ReplaceDialog(SearchStr, ReplaceStr, SearchOptions) then
            begin
              SearchReplace(SearchStr, ReplaceStr, SearchOptions);
              SearchAlready := True;
            end;
          cmSearchAgain:
            if SearchAlready then
              SearchReplace(SearchStr, ReplaceStr, SearchOptions);
          cmSave:
            Save;
          cmSaveAs:
            SaveAs;
          cmRestoreLine:
            RestoreLine;
          cmCut:
            Cut;
          cmCopy:
            Copy;
          cmPaste:
            Paste;
          cmClear:
            Clear;
          cmToggleBreakpoint:
            ToggleBpt;
          cmGotoLineNumber:
            GotoLine;
          cmPrint:
            begin
              SaveModified:=EditData^.Modified;
              DoFunc1(edWriteFile, Pointer(4));
              EditData^.Modified:=SaveModified;
            end;
        else
          Exit;
        end;
        ClearEvent(Event);
      end;
    evBroadcast:
      if Event.Command = cmScrollBarChanged then
        with Editor^ do
          if (HScrollBar = Event.InfoPtr) and
            (HScrollBar^.Value <> ScreenPos.X) then
          begin
            ScreenPos.X:=HScrollBar^.Value;
            DrawView;
          end else if (VScrollBar = Event.InfoPtr) and
            (VScrollBar^.Value<>ScreenPos.Y) then
          begin
            ScreenPos.Y := VScrollBar^.Value;
            DrawView;
          end;
    evEditor, evConfig:
      case Event.Command of
        cmFindEditor:
          if (Event.InfoPtr = nil) or
            (Editor^.FileRec^.FileName = PString(Event.InfoPtr)^) then
            ClearEvent(Event);
        cmDirChanged:
          PWindow(Owner)^.Frame^.DrawView;
        cmSaveAll:
          if Modified and not Save then
            ClearEvent(Event);
        cmUpdateCommandTable:
          Editor^.CommandTable := Event.InfoPtr;
        cmUpdateColors:
          SetColors;
      end;
  end;
end;

procedure TEditView.SetBpt(var B: TBreakpoint);
begin
  FillChar(B, SizeOf(B), 0);
  B.FileName := Editor^.FileRec^.FileName;
  B.LineNumber := Editor^.CursorPos.Y;
end;

function TEditView.BlockSet: Boolean;
begin
  BlockSet := (Editor^.Options and eoBlockHidden = 0) and
    ((Editor^.BlockBeg.X <> Editor^.BlockEnd.X) or
    (Editor^.BlockBeg.Y <> Editor^.BlockEnd.Y));
end;

function TEditView.CanRestore: Boolean;
begin
  CanRestore := Editor^.UndoBeg.Y <> 0;
end;

function TEditView.Noname: Boolean;
begin
  Noname := Unnamed(Editor^.FileRec^.FileName);
end;

function TEditView.DoFunc(Func: Word): Integer;
begin
  DoFunc := EditFunc(Editor, Func, nil, 0);
end;

function TEditView.DoFunc1(Func: Word; Param: Pointer): Integer;
begin
  DoFunc1 := EditFunc(Editor, Func, Param, 0);
end;

procedure TEditView.Message(I: Integer);
begin
  MessageBox(I + sEditorErrorBase, nil, mfError + mfOkButton);
end;

function TEditView.Modified: Boolean;
begin
  Modified := EditData^.Modified and (emShow + emUpdate) <> 0;
end;

function TEditView.RwBlock(Mode: Word): Integer;
var
  H: Integer;
  Name: PathStr;
  P: Pointer;
  I: Word;
  PP: Pointer;
begin
  Name := '';
  H := -1;
  if Mode = 0 then
  begin
    I := ExecDialog('ReadBlockDialog', @Name);
    if I <> cmCancel then
    begin
      H := FOpen(Name, 0);
      if H < 0 then
        MessageBox(sFileNotFound, ParamFile(Name), mfError + mfOkButton);
    end;
  end else
  begin
    I := ExecDialog('WriteBlockDialog', @Name);
    if (I <> cmCancel) and (not FileExists(Name) or
      (MessageBox(sFileExists, ParamFile(Name), mfWarning + mfYesNoCancel) =
      cmYes)) then
    begin
      H := FOpen(Name, 3);
      if H < 0 then
        MessageBox(sCantCreate, ParamFile(Name), mfError + mfOkButton);
    end;
  end;
  RwBlock := H;
end;

procedure TEditView.Repaint;
begin
  DoFunc(edFullPaintScreen);
  Update;
end;

procedure TEditView.Paste;
begin
  if Clipboard <> nil then
  begin
    Clipboard^.DoFunc1(edWriteBlk, Pointer(hVMem));
    DoFunc1(edReadBlk, Pointer(hVMem));
    Repaint;
  end;
end;

procedure TEditView.ChangeName(S: PathStr);
var
  P: PEditor;
begin
  with Editor^.FileRec^ do
  begin
    FileName := S;
    P := Editor;
    while P <> nil do
    begin
      PEditView(P^.EditView)^.UpdateFrame;
      P := P^.Next;
    end;
  end;
end;

procedure TEditView.EditNewFile(var S: PathStr);
begin
  DoneEditor;
  InitEditor(S);
  SetScrollBars;
  SetColors;
  Draw;
  UpdateFrame;
end;

function TEditView.ReplaceDialog(var S1, S2: TSearchStr; var Opts: Word):
  Boolean;
const
  R: record
    S1, S2: TSearchStr;
    Opts: Word;
    Direction: Word;
    Scope: Word;
    Origin: Word;
  end = (S1: ''; S2: ''; Opts: 8; Direction: 0; Scope: 0; Origin: 1);
var
  I: Word;
begin
  R.S1 := '';
  I := ExecDialog('ReplaceDialog', @R);
  if I <> cmCancel then
  begin
    S1 := R.S1;
    S2 := R.S2;
    Opts := esReplace;
    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.Opts and 8 = 0 then
      Inc(Opts, esNoPrompt);
    if R.Direction <> 0 then
      Inc(Opts, esBackward);
    if R.Scope <> 0 then
      Inc(Opts, esSelectedText);
    if R.Origin <> 0 then
      Inc(Opts, esEntireScope);
    if I = cmChangeAll then
      Inc(Opts, esChangeAll);
    ReplaceDialog := True;
  end else
    ReplaceDialog := False;
end;

procedure TEditView.RestoreLine;
begin
  DoFunc(edRestoreLine);
  Repaint;
end;

function TEditView.SaveAs: Boolean;
var
  S: PathStr;
  P: Pointer;
begin
  SaveAs := False;
  S := '';
  if (ExecDialog('SaveAsDialog', @S) <> cmCancel) and (not FileExists(S) or
    (MessageBox(sFileExists, ParamFile(S), mfWarning + mfYesNoCancel) =
    cmYes)) then
  begin
    ChangeName(S);
    SaveAs := SaveFile;
  end;
end;

function TEditView.Save: Boolean;
begin
  if Noname then
    Save := SaveAs
  else
    Save := SaveFile;
end;

function TEditView.SaveFile: Boolean;
var
  H: Integer;
  BakFile, TempFile: PathStr;
  P: ^PathStr;
  Success: Boolean;
  SaveModified: Word;

function ForceExt(var S: PathStr; NewExt: ExtStr): PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(S, Dir, Name, Ext);
  ForceExt := Dir + Name + NewExt;
end;