unit classcopy;
{
   Expert to help writing methods in Delphi 3.0x
   Made by using Etk by Ray Lischner
   (see Dr. Dobb's #282 February 1998 p.88-104)
   Be free to test this, but if changes is made to source, please
   communicate with me!

   Author:  Vesa Lappalainen, vesal@math.jyu.fi
   Date:    08.02.1998
   Changes: 11.02.1998
     + no more extra // after method if no virtual and so on on place
     + can handle greater file than 32k (bug in TIEditReader?)
     + "ClassExpt/Property Read Write" works if not pressed
       many times over the same attribute
   Changes: 21.02.1998
     + property adding


   Usage:   Install package
              Component/Install Packages/Add and choose ClassExp.dpl

            (Installing from source ClassExp.dpk is done by opening
             ClassExp.dpk in Delphi 3.0x
             and then press compile.  To compile it you must own the
             Etk by Tempest Sofware, Inc.)

            Using ClassExpt after installing the package
            =================================================================
            (those marked by * does not work in this version)

            1) To write a new class follow the steps:
               a) Write classc and press "Ctrl-J" (Delphi's Code Insight)
               b) Fill the class name and parent's name.
               c) go over the line: constructor Create; override;
                  and press "ClassExpt/Copy Method" (from menu)
                  ClassExpt will find the class name (f.ex TName) and change the
                  line to
                    //----------------------------------------------
                    constructor TName.Create; // override;
                    begin
                      inherited;
                    end;
                  and copy that line as last method in implementation part.
               d) The cursor will stay in class declaration part and you
                  can continue to copy other methods.

            2)  To add methods to old class just write the method 'prototype'
                and press "ClassExpt/Copy Method"
                If method already exists it's not copied

           *3)  You can also write the method implementation first and
                then press "ClassExpt/Copy Method" over the method to
                make the method 'prototype'.  The commented override etc.
                will come a valid directive in 'prototype'.
                To make the 'prototype' you can be anywhere over the
                methdo implementation (between the first line and
                end; ending the method in first column).
                The 'prototype' will come under public-section under the
                class name found before method name.

           *4)  You can delete method pressing "ClassExpt/Delete Method"
                over the prototype or over the implementation of method.
                Possible comments before method you must remove you self.

            5)  To add a new property, write the property variable
                with name FName:type and the press either
                  "ClassExpt/Property Read Write" to get a full set of

                    public
                      function  GetName:type;        virtual;
                      procedure SetName(value:type); virtual;
                    published
                      property Name:type read GetName write SetName;

                   and of course the corresponding implementation also:
                      //---------------------------------------------------
                      function  TName.GetName:type;        // virtual;
                      begin
                        Result := FName;
                      end;


                      //---------------------------------------------------
                      procedure TName.SetName(value:type); // virtual;
                      begin
                        FName := value;
                      end;

                or press
                  "ClassExpt/Property read Write" to get a full set for
                      property Name:type read FName write SetName;
                  "ClassExpt/Property Read" to get a full set for
                      property Name:type read GetName;
                  "ClassExpt/Property read write" to get
                      property Name:type read FName write FName;
                  "ClassExpt/Property read" to get
                      property Name:type read FName;

           *6)  Pressing the same keys over line
                      property Name:type
                will fill you the property line correspondingly and
                add also the property attribute under private-section.

           *7)  Pressing "ClassExpt/Property Delete" over the property
                attribute or property line will delete everything
                involving the property

           *8)  Pressing "ClassExpt/Rename" over attribute, property or
                method will open an rename Dialog-box and renames attribute
                property or method correspondingly.

   Future plans:
     - user defined shortcuts for menu equivalents
     - user defined form for inserted methods (like in Code Insight)
     - more general syntax to work also in CBuilder
     - copy many methods under marked block
     - add many properties under marked block
     - quick jump to added methods (need to know how to make bookmarks
       on expert)

   Know bugs:
     - add's the same property many times
     - does not find the last method for current class, instead adds to the end
     - method must be in one line
     - "end;" ending the method must be on first column
       if other "end;" in first colunm the ClassExpt may do #¤%&
     - if no "end;" in first column or no "implementation" part, then
       first method is inserted in wrong place
     - comments and #ifdef's are ignored
     - class, end, procedure, function, constructor, destructor must be written
       by lowercas letter's at the moment (the upos function is
       just pos in prototype)
     - now it's line based, so "TName = class(TParent)" must be in one line


}
interface

uses Windows, SysUtils, Classes, Graphics, Dialogs, Forms,
  ExptIntf, ToolIntf, EditIntf, Etk;

type
  //----------------------------------------------------------------------------
  TEtkAddClass = class(TEtkModule)
    ClassExptMenu: TEtkMenuItem;
    CopyMethod: TEtkMenuItem;
    DeleteMethod: TEtkMenuItem;
    PropertyReadWrite: TEtkMenuItem;
    Property_readWrite: TEtkMenuItem;
    PropertyRead: TEtkMenuItem;
    Property_read_write: TEtkMenuItem;
    Property_read: TEtkMenuItem;
    PropertyDelete: TEtkMenuItem;
    Rename: TEtkMenuItem;
//    EditAddClass : TEtkMenuItem;
    procedure CopyMethodClick(Sender : TObject);
    procedure PropertyReadWriteClick(Sender: TObject);
    procedure Property_readWriteClick(Sender: TObject);
    procedure PropertyReadClick(Sender: TObject);
    procedure Property_read_writeClick(Sender: TObject);
    procedure Property_readClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

type
  //----------------------------------------------------------------------------
  TEditorItems = class // Class to make it easier to use TIEditor info and so on
  public
    Text     : string;
    items    : integer;
    Module   : TIModuleInterface;
    Editor   : TIEditorInterface;
    View     : TIEditView;
    Reader   : TIEditReader;
    Writer   : TIEditWriter;
    StartPos : LongInt;
    AfterPos : LongInt;
    CurPos   : LongInt;
    CurEPos  : TEditPos;
    CurCPos  : TCharPos;
    EofCPos  : TCharPos;
    EofPos   : LongInt;
    Lines    : TStringList;
    constructor Create(TextAlso:boolean); virtual;
    destructor  Destroy; override;
    function GetReader : boolean;
    function GetWriter : boolean;
    function BytePos(line:integer) : LongInt;
    class function CreateN(n:integer;TextAlso:boolean) : TEditorItems; virtual;
  end;

var
  EtkAddClass: TEtkAddClass;
  procedure Register;

implementation
uses stexp;

//------------------------------------------------------------------------------
procedure Register;
begin
  TEtkAddClass.CreateAndRegister(EtkAddClass);
end;


{$R *.DFM}
//------------------------------------------------------------------------------
// TEditorItems
//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
procedure GetTextFromReader(Reader:TIEditReader;var s:string; n:integer);
// We must do this, becouse Reader.GetText takes only 32kB at the time!
var istart,ilen,iblock:integer;
begin
  SetLength(s,n);
  istart := 0; ilen := n; iblock := 30000;
  repeat
    if ( iblock > ilen ) then iblock := ilen;
    Reader.GetText(istart,PChar(s)+istart,iblock);
    inc(istart,iblock);
    dec(ilen,iblock);
  until ( ilen <= 0 );
end;


constructor TEditorItems.Create(TextAlso:boolean);
begin
  Module   := nil;
  Editor   := nil;
  View     := nil;
  Reader   := nil;
  Writer   := nil;
  Lines    := nil;
  items    := 0;

  if ( not Assigned(ToolServices) ) then exit;

  Lines := TStringList.Create;
  with ToolServices do
    Module := GetModuleInterface(GetCurrentFile);
  if  Module = nil then exit;
  inc(items);
  Editor := Module.GetEditorInterface; if ( Editor = nil ) then exit;
  inc(items);
  View := Editor.GetView(0);           if ( View = nil ) then exit;
  inc(items);
  StartPos := View.CharPosToPos(Editor.BlockStart);
  AfterPos := View.CharPosToPos(Editor.BlockAfter);
  CurEPos  := View.CursorPos;
  if ( CurEPos.Line < 1 ) then CurPos := 0
  else begin
    View.ConvertPos(True,CurEPos,CurCPos);
    CurPos := View.CharPosToPos(CurCPos);
  end;
  EofCPos.Line := Editor.LinesInBuffer; EofCPos.CharIndex := 1000;
  EofPos := View.CharPosToPos(EofCPos);
//  EofCPos := View.PosToCharPos(EofPos); // EI tykää toimia, Access Violation
  if ( TextAlso ) then begin
    Reader := Editor.CreateReader;
    if ( Assigned(Reader) ) then begin
      GetTextFromReader(Reader,Text,EofPos);
      Reader.Release;
      Lines.Text := Text;
    end;
    Reader := nil;
  end;
  Writer := Editor.CreateUndoableWriter; if ( Writer = nil ) then exit;
  inc(items);
end;

class function TEditorItems.CreateN(n:integer;TextAlso:boolean) : TEditorItems;
begin
  Result := TEditorItems.Create(TextAlso);
  if ( Result = nil ) then exit;
  if ( Result.Items  >= n ) then exit;
  Result.Free;
  Result := nil;
end;

destructor  TEditorItems.Destroy;
begin
  if ( Assigned(Lines)  ) then  Lines.Free;
  if ( Assigned(Writer) ) then  Writer.Release;
  if ( Assigned(Reader) ) then  Reader.Release;
  if ( Assigned(View)   ) then  View.Release;
  if ( Assigned(Editor) ) then  Editor.Release;
  if ( Assigned(Module) ) then begin
//    Module.ShowSource;
    Module.Release;
  end;
end;

function TEditorItems.GetReader : boolean;
begin
  Result := false;
  if ( not Assigned(Editor) ) then exit;
  Result := true;
  if ( Assigned(Reader) ) then exit;
  if ( Assigned(Writer) ) then  Writer.Release;
  Writer := nil;
  Reader := Editor.CreateReader;
  Result := ( Reader <> nil );
end;

function TEditorItems.GetWriter : boolean;
begin
  Result := false;
  if ( not Assigned(Editor) ) then exit;
  Result := true;
  if ( Assigned(Writer) ) then Exit;
  if ( Assigned(Reader) ) then  Reader.Release;
  Reader := nil;
  Writer := Editor.CreateUndoableWriter;
  Result := ( Writer <> nil );
end;

function TEditorItems.BytePos(line:integer) : LongInt;
var p:TCharPos;
begin
  Result := 0;
  if ( View = nil ) then exit;
  p.line := line+1; p.CharIndex := 0;
  Result := View.CharPosToPos(p)
end;

{
//------------------------------------------------------------------------------
procedure ShowLines(const Lines:TStrings);
var  ms : string;
     i : integer;
begin
  ms := '--------------------------------------------------'+#13#10;
  for i:=0 to Lines.Count-1 do begin
    ms := ms+ Format('%3d ',[i])+Lines.Strings[i]+#13#10;
  end;
  ms := ms + '--------------------------------------------------';
  ShowMessage(ms);
end;

//------------------------------------------------------------------------------
// ClassExpt tasks:
//------------------------------------------------------------------------------
procedure AddStringToPos(s:string; p:integer);
var  e : TEditorItems;
begin
  e := TEditorItems.CreateN(4,false);  if ( e = nil ) then exit;
  with e do begin
//    ShowMessage(Format('%d %d %d %d',[StartPos,AfterPos,CurPos, EofPos]));
//    ShowLines(Lines);
    if ( p < 0 ) then p := CurPos;
    Writer.CopyTo(p);
    Writer.Insert(PChar(s));
  end;
  e.Free;
end;
}

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------

//------------------------------------------------------------------------------
procedure CopyMethodUnderCursor;
var  e : TEditorItems;
     InsertPos : integer; NewMethod : string;
begin
  e := TEditorItems.CreateN(4,true);  if ( e = nil ) then exit;
  try with e do begin
    NewMethod := GetNewClassMethod(Lines,CurCPos.Line-1,'',InsertPos);
    if ( NewMethod = '' ) then exit;
    Writer.CopyTo(BytePos(InsertPos+1));
    Writer.Insert(PChar(NewMethod));
  end;
  finally e.Free;  end;
end;

//------------------------------------------------------------------------------
procedure HandlePropertyUnderCursor(typs:TAddPropertySet);
var  e : TEditorItems;
begin
  e := TEditorItems.CreateN(4,true);  if ( e = nil ) then exit;
  try with e do begin
    if not AddPropertyUnder(Lines,CurCPos.Line-1,typs) then exit;
    Writer.DeleteTo(EofPos);
    Writer.Insert(PChar(Lines.Text));
  end;
  finally e.Free;  end;
end;

//------------------------------------------------------------------------------
procedure TEtkAddClass.CopyMethodClick(Sender : TObject);
begin
  CopyMethodUnderCursor;
end;

procedure TEtkAddClass.PropertyReadWriteClick(Sender: TObject);
begin
  HandlePropertyUnderCursor([proRead,proWrite]);
end;

procedure TEtkAddClass.Property_readWriteClick(Sender: TObject);
begin
  HandlePropertyUnderCursor([proFRead,proWrite]);
end;

procedure TEtkAddClass.PropertyReadClick(Sender: TObject);
begin
  HandlePropertyUnderCursor([proRead]);
end;

procedure TEtkAddClass.Property_read_writeClick(Sender: TObject);
begin
  HandlePropertyUnderCursor([proFRead,proFWrite]);
end;

procedure TEtkAddClass.Property_readClick(Sender: TObject);
begin
  HandlePropertyUnderCursor([proFRead]);
end;

end.