{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor (MDI Application)                                    }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
unit EditFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ecSyntAnal, ExtCtrls, ecSyntMemo, Menus, ecActns, StdActns, ActnList,
  ComCtrls, ImgList, ecSpell, ecExtHighlight, ActiveX, ecOleDrag, ecEmbObj,
  ecPopupCtrl;

type
  TEditorFrame = class(TFrame)
    EditorSlave: TSyntaxMemo;
    Splitter2: TSplitter;
    EditorMaster: TSyntaxMemo;
    ecSpellChecker1: TecSpellChecker;
    TextSource: TecEmbeddedObjects;
    HyperlinkHighlighter1: THyperlinkHighlighter;
    procedure EditorMasterEnter(Sender: TObject);
    procedure EditorMasterSetBookmark(Snder: TObject; Bookmark: TBookmark;
      var Accept: Boolean);
    procedure FrameResize(Sender: TObject);
    procedure SplitterMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditorMasterGetTokenHint(Sender: TObject;
      TokenIndex: Integer; var HintText: String);
    procedure EditorMasterChange(Sender: TObject);
    procedure EditorMasterCaretPosChanged(Sender: TObject);
    procedure EditorSlaveGetStyleEntry(Sender: TObject; CurPos: Integer;
      StyleList: TStyleEntries; var NextPos: Integer);
    procedure EditorMasterGetGutterImage(Sender: TObject;
      const Line: Integer; List: TList);
    procedure SyncEditClick(Sender: TObject; Line: integer; Shift: TShiftState);
    procedure EditorMasterGetStyleEntry(Sender: TObject; CurPos: Integer;
      StyleList: TStyleEntries; var NextPos: Integer);
    procedure EditorMasterExecuteCommand(Sender: TObject; Command: Integer;
      Data: Pointer; var Handled: Boolean);
    procedure EditorMasterOleDragEnter(Sender: TObject;
      const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
      var Effect: Integer; var Handled: Boolean);
    procedure EditorMasterOleDragOver(Sender: TObject; const DataObject: IDataObject; KeyState: Integer;
      Pt: TPoint; var Effect: Integer; var Handled: Boolean);
    procedure EditorMasterOleDrop(Sender: TObject;
      const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
      var Effect: Integer; var Handled: Boolean);
    procedure EditorMasterCheckChar(Sender: TObject; C: Word;
      var IsWord: Boolean);
    procedure EditorMasterModifiedChanged(Sender: TObject);
    procedure EditorMasterBeforeDrawStaple(Sender: TObject;
      Canvas: TCanvas; Staple: TBlockStaple; Level: Integer);
  private
    FFileName: string;
    FOnTitleChanged: TNotifyEvent;
//    FPrevMod: Boolean;
    procedure SetFileName(const Value: string);
    function GetModified: boolean;
    procedure SetModified(const Value: boolean);
    function GetTitle: string;
  protected
    procedure TitleChanged;
  public
    constructor Create(AOwner: TComponent); override;
    procedure SaveFile(const AFileName: string);
    procedure LoadFile(const AFileName: string);
    function IsTheFile(const AFileName: string): Boolean;
    function IsNewFile: Boolean;

    property FileName: string read FFileName write SetFileName;
    property Modified: boolean read GetModified write SetModified;
    property Title: string read GetTitle;
    property OnTitleChanged: TNotifyEvent read FOnTitleChanged write FOnTitleChanged;
  end;

implementation

uses main, ecStrUtils, ecCmdConst;

const
  SUntitledFile = 'Untitled';

{$R *.dfm}

// Initializing events
type
  TControlHack = class(TControl);
constructor TEditorFrame.Create(AOwner: TComponent);
begin
  inherited;
  TControlHack(Splitter2).OnMouseDown := SplitterMouseDown;
  ecSpellChecker1.Dictionary := SyntEditMain.ecDictionary1;
  TextSource.Lines.SetObjectsStore;
  EditorMaster.PopupMenu := SyntEditMain.PopupMenu2;
  EditorSlave.PopupMenu := SyntEditMain.PopupMenu2;
  EditorMaster.Gutter.Images := SyntEditMain.ImageList1;
  EditorSlave.Gutter.Images := SyntEditMain.ImageList1;
end;

procedure TEditorFrame.EditorMasterEnter(Sender: TObject);
begin
  SyntEditMain.CurrentEditor := (Sender as TSyntaxMemo);
end;

procedure TEditorFrame.EditorMasterSetBookmark(Snder: TObject;
  Bookmark: TBookmark; var Accept: Boolean);
begin
  with Bookmark do
   if (BmIndex >= 0) and (BmIndex < 10) then
    begin
     ImageIndex := 13 + BmIndex;
     Hint := 'Bookmark ' + IntToStr(BmIndex);
    end;
end;

procedure TEditorFrame.SetFileName(const Value: string);
begin
  FFileName := Value;
end;

procedure TEditorFrame.SaveFile(const AFileName: string);
var attr: integer;
begin
  with TextSource do
    begin
      {$IFDEF EC_UNICODE}
      if (Lines.TextCoding = tcAnsi) and  Lines.ContainUnicode and
         (MessageBox(Handle, 'Text contains Unicode characters. Would you like to save text in Unicode format?',
          'Warning', MB_ICONWARNING or MB_YESNO) = IDYES) then
        Lines.TextCoding := tcUnicode;
      {$ENDIF}
      if FileExists(FileName) then
        begin
          attr := FileGetAttr(AFileName);
          if (attr and faReadOnly) <> 0 then
            if MessageBox(Handle, 'Do you want to overwrite read only file?',
                 'Warning', MB_ICONWARNING or MB_YESNO ) = IDNO then
               Exit
            else
               FileSetAttr(FileName, attr and (not faReadOnly));
        end;
      EditorMaster.SaveToFile(AFileName);
//      EditorSlave.Modified := False;
      FFileName := AFileName;
      TitleChanged;
    end;
end;

procedure TEditorFrame.LoadFile(const AFileName: string);
begin
  EditorMaster.LoadFromFile(AFileName);
  EditorSlave.Modified := False;
  FFileName := ExpandFileName(AFileName);
  TitleChanged;
end;

procedure TEditorFrame.FrameResize(Sender: TObject);
begin
  if not EditorSlave.Visible or (EditorSlave.Height = 0) then
    EditorSlave.Top := 0;
end;

procedure TEditorFrame.SplitterMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FrameResize(Self);
end;

function TEditorFrame.GetModified: boolean; 
begin
  Result := EditorMaster.Modified;
end;

procedure TEditorFrame.SetModified(const Value: boolean);
begin
  EditorSlave.Modified := Value;
  EditorMaster.Modified := Value;
end;

function TEditorFrame.GetTitle: string;
begin
  if FFileName = '' then
    Result := SUntitledFile
  else
    Result := ExtractFileName(FFileName);
  if Modified then
    Result := Result + '*';
//  FPrevMod := Modified;
end;

procedure TEditorFrame.TitleChanged;
begin
  if Parent <> nil then
    if Parent is TTabSheet then
      (Parent as TTabSheet).Caption := Title else
    if Parent is TCustomForm then
      (Parent as TCustomForm).Caption := Title;
  if Assigned(FOnTitleChanged) then
    FOnTitleChanged(Self);
end;

function TEditorFrame.IsTheFile(const AFileName: string): Boolean;
var s1, s2: string;
begin
  // To use MS CharUpper
  Result := (Length(FFileName) = Length(AFileName)) and
            (Length(FFileName) > 0);
  if Result then
    begin
      s1 := Copy(FFileName, 1, Length(FFileName));
      s2 := Copy(AFileName, 1, Length(AFileName));
      Result := not IsNewFile and
                (string(CharUpper(PChar(s1))) =
                 string(CharUpper(PChar(s2))));
    end;
end;

function TEditorFrame.IsNewFile: Boolean;
begin
  Result := FFileName = '';
end;

procedure TEditorFrame.EditorMasterGetTokenHint(Sender: TObject;
  TokenIndex: Integer; var HintText: String);
var p: TPoint;
begin
 try
// This example show how to get token information and use it for hint showing
  if (Sender as TSyntaxMemo).SyntObj <> nil then
  with (Sender as TSyntaxMemo).SyntObj do
   begin
    HintText := 'Token:      ' + TagStr[TokenIndex] + sLineBreak;
    if Length(HintText) > 100 then HintText := '';
    p := TagPos[TokenIndex];
    HintText := HintText +
               'Rule:       ' + Tags[TokenIndex].Rule.DisplayName + sLineBreak +
               'Token pos:  ' + Format('(X: %d; Y: %d)', [p.X + 1, p.Y + 1]) + sLineBreak +
               'Position: ' + IntToStr(TokenIndex);
   end;
 except
  on E: Exception do
   HintText := E.Message;
 end;
end;

procedure TEditorFrame.EditorMasterModifiedChanged(Sender: TObject);
begin
  TitleChanged;
  SyntEditMain.UpdateStatusBar(EditorMaster);
end;

procedure TEditorFrame.EditorMasterChange(Sender: TObject);
begin
//  if FPrevMod <> Modified then TitleChanged;
  SyntEditMain.UpdateStatusBar(Sender);
end;

procedure TEditorFrame.EditorMasterCaretPosChanged(Sender: TObject);
begin
  SyntEditMain.UpdateStatusBar(Sender);
end;

procedure TEditorFrame.EditorSlaveGetStyleEntry(Sender: TObject;
  CurPos: Integer; StyleList: TStyleEntries; var NextPos: Integer);
var tmp: integer;
begin
  NextPos := ecSpellChecker1.GetStyleList(CurPos, StyleList);
  tmp := HyperlinkHighlighter1.GetStyleList(CurPos, StyleList);
  if (tmp <> -1) and (tmp < NextPos) or (NextPos = -1) then
    NextPos := tmp; 
end;

procedure TEditorFrame.EditorMasterGetGutterImage(Sender: TObject;
  const Line: Integer; List: TList);
var gi: TGutterObject;
    Memo: TSyntaxMemo;
begin
  Memo := EditorMaster;
  if (Memo.SelLength > 0) and
     (Line = Memo.StrPosToCaretPos(Memo.SelStart + Memo.SelLength).Y) then
   begin
    gi := TGutterObject.Create(nil);
    gi.OnClick := SyncEditClick;
    gi.ImageIndex := 58;
    gi.Hint := 'Create sync range';
    List.Add(gi);
    Exit;
   end;
  if Memo.SyncEditing.RangeEndAtLine(Line) <> -1 then
   begin
    gi := TGutterObject.Create(nil);
    gi.ImageIndex := 59;
    gi.Hint := 'Remove sync range';
    gi.OnClick := SyncEditClick;
    List.Add(gi);
    Exit;
   end;
end;

procedure TEditorFrame.SyncEditClick(Sender: TObject; Line: integer;
  Shift: TShiftState);
var idx: integer;
begin
  if EditorMaster.SelLength > 0 then
    EditorMaster.SyncEditing.AddCurSelection
  else
   begin
    idx := EditorMaster.SyncEditing.RangeEndAtLine(Line);
    if idx <> -1 then
      EditorMaster.SyncEditing.Delete(idx);
   end;
end;

procedure TEditorFrame.EditorMasterGetStyleEntry(Sender: TObject;
  CurPos: Integer; StyleList: TStyleEntries; var NextPos: Integer);
const OFFSET = 72;
var p: TPoint;
    L: integer;
begin
  with EditorMaster do
   begin
     p := StrPosToCaretPos(CurPos);
     L := Lines.LineLength(p.Y);
     if (p.X >= OFFSET) and (p.X < L) then
      begin
       NextPos := CurPos + L - p.X;
       StyleList.Add(HyperlinkHighlighter1.Style, CurPos + L - OFFSET, NextPos);
      end else
      begin
       p.X := OFFSET;
       while (p.Y < Lines.Count) and (Lines.LineLength(p.Y) < OFFSET) do
         Inc(p.Y);
       if p.Y = Lines.Count then NextPos := -1
        else NextPos := CaretPosToStrPos(p);
      end;
   end;
end;

procedure TEditorFrame.EditorMasterExecuteCommand(Sender: TObject;
  Command: Integer; Data: Pointer; var Handled: Boolean);
//var p: TPoint;
begin
  with TCustomSyntaxMemo(Sender) do
    if Command = smTab then
      begin
        Handled := HaveSelection;
        if Handled then
          ExecCommand(smBlockIndent);
      end{ else
    if Command = smScrollUp then
      begin
        Handled := True;
        ScrollPosY := ScrollPosY - 1;
        p := CaretToMouse(CaretPos.X, CaretPos.Y);
        if p.Y > ClientHeight - DefTextExt.cy then
          CaretPos := MouseToCaret(p.X, ClientHeight - DefTextExt.cy - 3);
      end else
    if Command = smScrollDown then
      begin
        Handled := True;
        ScrollPosY := ScrollPosY + 1;
        p := CaretToMouse(CaretPos.X, CaretPos.Y);
        if p.Y < 0 then
          CaretPos := MouseToCaret(p.X, 3);
      end};
end;

// OLE color assignment
var
  CF_DRAGCOLOR: Word = 0;
const
  CFSTR_DRAGCOLOR = 'Datras Drag Color';

procedure TEditorFrame.EditorMasterOleDragEnter(Sender: TObject;
  const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
  var Effect: Integer; var Handled: Boolean);
begin
  Handled := GetFormatInfo(DataObject, CF_DRAGCOLOR);
end;

procedure TEditorFrame.EditorMasterOleDragOver(Sender: TObject; const DataObject: IDataObject;
  KeyState: Integer; Pt: TPoint; var Effect: Integer;
  var Handled: Boolean);
begin
  Handled := GetFormatInfo(DataObject, CF_DRAGCOLOR);
end;

procedure TEditorFrame.EditorMasterOleDrop(Sender: TObject;
  const DataObject: IDataObject; KeyState: Integer; Pt: TPoint;
  var Effect: Integer; var Handled: Boolean);
var FormatInfo: TFormatEtc;
    Fg: Boolean;
    C: TColor;
    Medium: TStgMedium;
    Idx, W: integer;
    Data: Pointer;
begin
  with Sender as TSyntaxMemo do
   begin
     Handled := GetFormatInfo(DataObject, CF_DRAGCOLOR, FormatInfo);
     if Handled then
       begin
         Fg := (KeyState and MK_CONTROL) <> 0;
         Pt := ScreenToClient(Pt);
         if DataObject.GetData(FormatInfo, Medium) = S_OK then
         begin
           Data := GlobalLock(Medium.hGlobal);
           if Data <> nil then
           try
             Move(Data^, C, SizeOf(C));
           finally
             GlobalUnlock(Medium.hGlobal);
           end;
           ReleaseStgMedium(Medium);
         end;
         if Gutter.Visible and (Pt.X < Gutter.Width) then
           begin // Gutter
             if Fg then
               LineNumbers.Font.Color := C
             else
              begin
               W := 0;
               for Idx := 0 to Gutter.Bands.Count - 1 do
                 begin
                   if (Pt.X >= W) and (Pt.X < W + Gutter.Bands[Idx].Width) then
                     begin
                       if Gutter.Bands[Idx].Color = clNone then Break
                        else Gutter.Bands[Idx].Color := C;
                       Exit;
                     end;
                   Inc(W, Gutter.Bands[Idx].Width);
                 end;
               Gutter.Color := C;
              end;
           end else
         if ShowRightMargin and (abs(Pt.X - RightMargin * DefTextExt.cx) < 2) then
           begin
             RightMarginColor := C;
           end else
           begin
             Pt := MouseToCaret(Pt.X, Pt.Y);
             if (SyntObj = nil) or
                (Pt.Y < 0) or (Pt.Y >= Lines.Count) or
                (Pt.X >= Lines.LineLength(Pt.Y)) then
               begin // Default editor style
                 if Fg then
                   Font.Color := C
                 else
                   Color := C;
               end else
               begin
                 Idx := SyntObj.TokenAtPos(CaretPosToStrPos(Pt));
                 if (Idx <> -1) and (SyntObj.Tags[Idx].Rule <> nil) and
                    (SyntObj.Tags[Idx].Rule.Style <> nil) then
                   begin
                     if Fg then
                       SyntObj.Tags[Idx].Rule.Style.Font.Color := C
                     else
                       SyntObj.Tags[Idx].Rule.Style.BgColor := C;
                   end;
               end;
           end;
       end;
   end;
end;

procedure TEditorFrame.EditorMasterCheckChar(Sender: TObject; C: Word;
  var IsWord: Boolean);
begin
  if Pos(ecChar(C), '$#') > 0 then
    IsWord := True;
end;

function SelectedWordType(Memo: TSyntaxMemo; Pos: integer): integer;
var idx: integer;
begin
   Result := -1;
   if Assigned(Memo.SyntObj) then
     begin
       idx := Memo.SyntObj.TokenAtPos(Pos);
       if idx <> -1 then
         Result := Memo.SyntObj.Tags[idx].TokenType;
     end;
end;

procedure TEditorFrame.EditorMasterBeforeDrawStaple(Sender: TObject;
  Canvas: TCanvas; Staple: TBlockStaple; Level: Integer);
begin
{    if Level mod 5 = 0 then
       Canvas.Pen.Color := clBlue
     else if Level mod 5 = 1 then
       Canvas.Pen.Color := clRed
     else if Level mod 5 = 2 then
       Canvas.Pen.Color := clGreen
     else if Level mod 5 = 3 then
       Canvas.Pen.Color := clTeal
     else
       Canvas.Pen.Color := clGray}
end;

initialization
  CF_DRAGCOLOR := RegisterClipBoardFormat(CFSTR_DRAGCOLOR);

end.
