editor.pas

Turbo Pascal 6.0编译器源码

unit Editor;

{$O+,F+,S-,X+,V-}

interface

uses Objects, Drivers, Views, TDos, TVars, TEdit, CompVars, TWindows;

const

  gfProgram = 1;
  gfExec    = 2;
  gfAlways  = 4;
  gfNoTop   = 8;

  esReplace   = $1000;
  esNoPrompt  = $2000;
  esChangeAll = $4000;

  CEditView = #6#7#8#9#10;

  EditCommands = [cmFind, cmReplace, cmSearchAgain, cmSave, cmSaveAs, cmPrint,
    cmGotoLineNumber, cmFindProcedure, cmFindError, cmGotoCursor, cmCompile,
    cmToggleBreakpoint, cmTopicSearch];
  EditCommands2 = EditCommands + [cmCut, cmCopy, cmPaste, cmClear,
    cmRestoreLine];

type

  TSearchStr = string[80];

  PIndicator = ^TIndicator;
  TIndicator = object(TView)
    Location: TPoint;
    Modified: Boolean;
    constructor Init(var Bounds: TRect);
    procedure Draw; virtual;
    procedure SetState(AState: Word; Enable: Boolean); virtual;
    procedure SetValue(ALocation: TPoint; AModified: Boolean);
  end;

  PEditView = ^TEditView;
  TEditView = object(TView)
    HScrollBar, VScrollBar: PScrollBar;
    Indicator: PIndicator;
    Editor: PEditor;
    IsValid: Boolean;
    constructor Init(var Bounds: TRect;
      AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator;
      var AName: PathStr);
    constructor Load(var S: TStream);
    procedure InitEditor(var S: PathStr);
    destructor Done; virtual;
    procedure DoneEditor;
    procedure CenterScreen;
    procedure ChangeBounds(var Bounds: TRect); virtual;
    procedure Clear;
    procedure ClearModifiedFlag;
    procedure CopyToClip; virtual;
    function  CanReplace: Word;
    procedure Copy;
    procedure Cut;
    procedure CompilerError(var S: string);
    procedure Draw; virtual;
    function  EditData: PEditSegment;
    function  GetHelpCtx: Word; virtual;
    function  GetPalette: PPalette; virtual;
    procedure GotoLine;
    procedure GotoOldLine(I: Integer; Exec: Boolean);
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure SetBpt(var B: TBreakpoint);
    function  BlockSet: Boolean;
    function  CanRestore: Boolean;
    function  Noname: Boolean;
    function  DoFunc(Func: Word): Integer;
    function  DoFunc1(Func: Word; Param: Pointer): Integer;
    procedure Message(I: Integer);
    function  Modified: Boolean;
    function  RwBlock(Mode: Word): Integer;
    procedure Repaint;
    procedure Paste;
    procedure ChangeName(S: PathStr);
    procedure EditNewFile(var S: PathStr);
    function  ReplaceDialog(var S1, S2: TSearchStr; var Opts: Word): Boolean;
    procedure RestoreLine;
    function  SaveAs: Boolean; virtual;
    function  Save: Boolean;
    function  SaveFile: Boolean;
    procedure SearchFailure(var S: TSearchStr);
    function  SearchDialog(var S: TSearchStr; var Opts: Word): Boolean;
    procedure SearchReplace(var S1, S2: TSearchStr;var Opts: Word);
    procedure SetColors;
    procedure SetPos(X, Y: Integer);
    procedure SetScrollBars;
    procedure SetState(AState: Word;Enable: Boolean); virtual;
    procedure Store(var S: TStream);
    procedure ToggleBpt;
    function  TotalLines: Integer;
    procedure Update;
    procedure UpdateCommands;
    procedure UpdateFrame; virtual;
    function  Valid(Command: Word): Boolean; virtual;
  end;

  PClipboard = ^TClipboard;
  TClipboard = object(TEditView)
    constructor Init(var Bounds:TRect;
      AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator);
    constructor Load(var S: TStream);
    procedure CopyToClip; virtual;
    function  GetHelpCtx: Word; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    function  SaveAs: Boolean; virtual;
    procedure SetState(AState: Word; Enable: Boolean); virtual;
    procedure UpdateFrame; virtual;
    function  Valid(Command: Word): Boolean; virtual;
  end;

  PEditWindow = ^TEditWindow;
  TEditWindow = object(TTurboWindow)
    EditView: PEditView;
    constructor Init(var Bounds: TRect; AName: PString; ANumber: Integer);
    constructor Load(var S: TStream);
    function  GetTitle(MaxSize: Integer): TTitleStr; virtual;
    procedure Store(var S: TStream);
  end;

function  FindEditor(P: PString): PEditView;
procedure TopmostName(var S: PathStr);
function  CreateEditor(var S: PathStr; Replace, NoTop: Boolean): PEditView;
function  OpenFile(var S: PathStr; NoTop: Boolean): PEditView;
function  GoFileLine(S: PathStr; I: Integer; Options: byte): Boolean;
procedure SetOptions;

const

  Clipboard: PEditView = nil;
  DefTabSize: Word = 8;
  DefOptions: Word = eoAutoIndent + eoAutoOutdent;
  BackupFiles: Boolean = True;
  DefCommandTable: Pointer = nil;
  EditCount: Integer = 0;

const

  REditView: TStreamRec = (
    ObjType: 12000;
    VmtLink: Ofs(TypeOf(TEditView)^);
    Load:    @TEditView.Load;
    Store:   @TEditView.Store
  );
  RIndicator: TStreamRec = (
    ObjType: 12001;
    VmtLink: Ofs(TypeOf(TIndicator)^);
    Load:    @TIndicator.Load;
    Store:   @TIndicator.Store
  );
  RClipboard: TStreamRec = (
    ObjType: 12003;
    VmtLink: Ofs(TypeOf(TClipboard)^);
    Load:    @TClipboard.Load;
    Store:   @TClipboard.Store
  );
  REditWindow: TStreamRec = (
    ObjType: 12004;
    VmtLink: Ofs(TypeOf(TEditWindow)^);
    Load:    @TEditWindow.Load;
    Store:   @TEditWindow.Store
  );

implementation

uses App, VMem, TStatus, Compiler, Tracer, CompOpt, Utils, Fnames, StrNames,
  Context;

const

  ChangingOptions = eoOverwrite + eoAutoIndent + eoUseTab + eoAutoOutdent +
    eoOptimalFill + eoRoamingCursor;
  NoClipCommands = [cmSave, cmGotoCursor, cmCompile, cmToggleBreakpoint,
    cmTopicSearch];

  ClipName: string[8] = '$$CLIP$$';

constructor TIndicator.Init(var Bounds: TRect);
var
  R: TRect;
begin
  TView.Init(Bounds);
  GrowMode := gfGrowLoY + gfGrowHiY;
end;

procedure TIndicator.Draw;
var
  Color: Byte;
  Frame: Char;
  S: string[5];
  B: array[0..13] of Word;
begin
  if State and sfDragging <> 0 then
  begin
    Color := GetColor(3);
    Frame := #196;
  end else
  begin
    Color := GetColor(2);
    Frame := #205;
  end;
  MoveChar(B, Frame, Color, 14);
  if Modified then
    WordRec(B[0]).Lo := 15;
  Str(Location.Y, S);
  WordRec(B[6-Length(S)]).Lo := Ord(' ');
  MoveStr(B[7-Length(S)], S, Color);
  WordRec(B[7]).Lo := Ord(':');
  Str(Location.X, S);
  MoveStr(B[8], S, Color);
  WordRec(B[8+Length(S)]).Lo := Ord(' ');
  WriteBuf(0, 0, 14, 1, B);
end;

procedure TIndicator.SetValue(ALocation: TPoint; AModified: Boolean);
begin
  if (Longint(Location) <> Longint(ALocation)) or (Modified <> AModified) then
  begin
    Location := ALocation;
    Modified := AModified;
    DrawView;
  end;
end;

procedure TIndicator.SetState(AState: Word; Enable: Boolean);
begin
  TView.SetState(AState, Enable);
  if AState = sfDragging then
    DrawView;
end;

procedure ForEachEditor(Proc: Pointer);
var
  P: PFileRec;
  V: PEditor;
begin
  P := LoadedFiles;
  while P <> nil do
  begin
    V := P^.Editor;
    while V <> nil do
    begin
      asm
	PUSH    V.Word[2]
	PUSH    V.Word[0]
        PUSH    WORD PTR [BP]
        CALL    Proc
      end;
      V := V^.Next;
    end;
    P := P^.Next;
  end;
end;

procedure ShowError(Error: Integer);
var
  I: Integer;
begin
  for I := 0 to 5 do
    if (1 shl I) and Error <> 0 then
      PEditView(CurEditView)^.Message(I);
end;

function ParamFile(var S: PathStr): Pointer;
const
  L: array[0..0] of Longint = (0);
  SS: PathStr = '';
begin
  SS := S;
  ConvertPath(SS, 25);
  L[0] := Longint(@SS);
  ParamFile := @L;
end;

function Unnamed(var S: PathStr): Boolean;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(S, Dir, Name, Ext);
  if Length(Name) > 6 then
    Name[0] := #6;
  Unnamed := Name = 'NONAME';
end;

constructor TEditView.Init(var Bounds: TRect;
  AHScrollBar, AVScrollBar: PScrollBar; AIndicator: PIndicator;
  var AName: PathStr);
var
  P: Pointer;
begin
  TView.Init(Bounds);
  GrowMode := gfGrowHiX + gfGrowHiY;
  Options := Options or ofSelectable;
  EventMask := EventMask or (evBroadcast + evEditor + evConfig + evRightClick);
  HScrollBar := AHScrollBar;
  VScrollBar := AVScrollBar;
  Indicator := AIndicator;
  IsValid := True;
  ShowCursor;
  InitEditor(AName);
  SetScrollBars;
  if Editor^.Options and eoOverwrite <> 0 then
    BlockCursor
  else
    NormalCursor;
end;

constructor TEditView.Load(var S: TStream);
var
  Name: PathStr;
begin
  TView.Load(S);
  GetPeerViewPtr(S, HScrollBar);
  GetPeerViewPtr(S, VScrollBar);
  GetPeerViewPtr(S, Indicator);
  S.Read(Name[0], 1);
  S.Read(Name[1], Length(Name));
  IsValid := True;
  InitEditor(Name);
  S.Read(Editor^.ScreenPos, 19 * SizeOf(TPoint));
  S.Read(Editor^.Options, SizeOf(Word));
  DoFunc(edCenterFixScreenPos);
end;

procedure TEditView.InitEditor(var S: PathStr);
var
  I, J: Integer;
  P: PFileRec;
  L: array[0..0] of Longint;
begin
  New(Editor);
  FillChar(Editor^, SizeOf(Editor^), 0);
  with Editor^ do
  begin
    EditView := @Self;
    CommandTable := DefCommandTable;
    WindowWidth := Size.X;
    WindowHeight := Size.Y;
    Options := DefOptions;
    TabSize := DefTabSize;
    ErrorProc := nil;
    ScreenPos.X := 1;
    ScreenPos.Y := 1;
    CursorPos.X := 1;
    CursorPos.Y := 1;
    if S <> ClipName then
      Inc(EditCount);
    P := FindFile(S);
    if P <> nil then
      Handle := P^.Editor^.Handle
    else
    begin
      New(P);
      P^.Editor := nil;
      P^.Time := GetFileTime(S);
      if P^.Time = -1 then
        P^.Time := GetDateTime;
      P^.Next := LoadedFiles;
      P^.FileName := S;
      LoadedFiles := P;
    end;
    FileRec := P;
    Next := P^.Editor;
    P^.Editor := Editor;
    if Handle = nil then
    begin
      if DoFunc(edNop) < 0 then
      begin
        Message(eeNoVirtMem);
        IsValid := false;
      end else
      begin
        I := FOpen(S, 0);
        if I >= 0 then
        begin
          L[0] := Longint(@S);
          StatusLine^.PrintStr(sLoading, @L);
          if DoFunc1(edReadFile, Pointer(I)) <> 0 then
            MessageBox(sReadError, ParamFile(S), mfWarning + mfOkButton);
          FClose(I);
        end else if I <> -2 then
        begin
          L[0] := Longint(@S);
          if not ValidFileName(S) then
            MessageBox(sInvalidFileName, ParamFile(S), mfError + mfOkButton)
          else
            MessageBox(sUnableOpen, ParamFile(S), mfError + mfOkButton);
          IsValid := False;
        end;
        Bpts2Editor(P);
	EditData^.BreakPts := @P^.Breakpoints;
        DoFunc(edStorePagesInfo);
        if (ExecPos.Fn<>0) and (S = GetSourceName(ExecPos.Fn)^) then
          EditData^.ExecBar := ExecPos.Ln;
      end;
    end;
    if IsValid then
      ErrorProc := @ShowError;
  end;
end;

destructor TEditView.Done;
begin
  DoneEditor;
  TView.Done;
end;

procedure TEditView.DoneEditor;
var
  P, Q: PEditor;
  PP, QQ: PFileRec;
begin
  if Editor = nil then
    Exit;
  with Editor^ do
  begin
    if FileRec^.FileName <> ClipName then
      Dec(EditCount);
    MFree(UndoPtr, UndoBufLen);
    UndoPtr := nil;
    Q := nil;
    P := FileRec^.Editor;
    while P <> Editor do
    begin
      Q := P;
      P := P^.Next
    end;
    if Q = nil then
      FileRec^.Editor := P^.Next
    else
      Q^.Next := P^.Next;
    if FileRec^.Editor = nil then
    begin
      QQ := nil;
      PP := LoadedFiles;
      while PP <> FileRec do
      begin
        QQ := PP;
        PP := PP^.Next
      end;
      if QQ = nil then
        LoadedFiles := PP^.Next
      else
        QQ^.Next := PP^.Next;
      if Handle <> nil then
      begin
        DoFunc(edClearText);
        FreeVMem(Handle)
      end;
      Dispose(FileRec);
    end;
    Dispose(Editor);
  end;
end;

procedure TEditView.CenterScreen;
begin
  DoFunc(edCenterFixScreenPos);
  Repaint;
end;

procedure TEditView.ChangeBounds(var Bounds: TRect);
begin
  Editor^.WindowWidth := Bounds.B.X - Bounds.A.X;
  Editor^.WindowHeight := Bounds.B.Y - Bounds.A.Y;
  TView.ChangeBounds(Bounds);
  HScrollBar^.SetStep(Size.X, 1);
  VScrollBar^.SetStep(Size.Y, 1);
end;

procedure TEditView.Clear;
begin
  DoFunc(edDeleteBlockRaw);
  CenterScreen;
end;

procedure TEditView.ClearModifiedFlag;
begin
  EditData^.Modified := 0;
end;

procedure TEditView.CopyToClip;
const
  CR: array[0..1] of Char = ^M#0;
begin
  if Clipboard <> nil then
  begin
    Clipboard^.DoFunc(edEndCursorRaw);
    if Clipboard^.Editor^.CursorPos.X <> 1 then
      Clipboard^.DoFunc1(edInsertBuf, @CR);
    Clipboard^.DoFunc1(edReadBlk, Pointer(hVMem));
    Clipboard^.DoFunc(edMoveToBlockBegRaw);
    Clipboard^.CenterScreen;
  end;
end;

function TEditView.CanReplace: Word;
var
  P: TPoint;
begin
  MakeGlobal(Cursor, P);
  CanReplace := MessageBox(sQueryReplace, Pointer(P),
    mfInformation + mfAwarePoint + mfYesNoCancel);
end;

procedure TEditView.Copy;
begin
  if Clipboard <> nil then
  begin
    DoFunc1(edWriteBlk, Pointer(hVMem));
    CopyToClip;
    Update;
  end;
end;

procedure TEditView.Cut;
begin
  Copy;
  Clear;
end;

procedure TEditView.CompilerError(var S: string);
var
  Color: Byte;
  I: Integer;
  B: TDrawBuffer;
begin
  Color := GetColor(3);
  MoveChar(B, ' ', Color, Size.X);
  MoveStr(B[1], S, Color);
  if Cursor.Y = 0 then
    I := Size.Y - 1
  else
    I := 0;
  WriteBuf(0, I, Size.X, 1, B);
end;

procedure TEditView.Draw;
begin
  Editor^.PrevScreenRow := 0;
  FillChar(Editor^.LineLens, SizeOf(Editor^.LineLens), 255);
  DoFunc(edSmartRefreshScreen);
end;

function TEditView.EditData: PEditSegment;
begin
  EditData := UseHandle(Editor^.Handle);
end;

function TEditView.GetHelpCtx: Word;
begin
  if ProgramStatus = psRunning then
    HelpCtx := hcDebugging
  else
    HelpCtx := hcEditWindow;
  GetHelpCtx := TView.GetHelpCtx;
end;

function TEditView.GetPalette: PPalette;
const
  P: string[Length(CEditView)] = CEditView;
begin
  GetPalette := @P;
end;

procedure TEditView.GotoLine;
const
  I: Integer = 1;
begin
  if ExecDialog('GotoLineDialog', @I) <> cmCancel then
    SetPos(1, I);
end;

procedure TEditView.GotoOldLine(I: Integer; Exec: Boolean);
begin
  DoFunc1(edFindOldLine, Pointer(I));
  if Exec then
    EditData^.ExecBar := Editor^.CursorPos.Y;
  CenterScreen;
end;

procedure TEditView.HandleEvent(var Event: TEvent);
const
  Dummy: Integer = 0;
  SearchStr: TSearchStr = '';
  ReplaceStr: TSearchStr = '';
  SearchOptions: Word = 0;
  SearchAlready: Boolean = False;
  Selecting: Boolean = False;
  P: TPoint = (X: 0; Y: 0);
var
  Mouse: TPoint;