lazarus/components/simplewebservergui/simplewebsrvwnd.pas

{
  Author: Mattias Gaertner
}
unit SimpleWebSrvWnd;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Process,
  // lazutils
  LazFileUtils, LazLogger, LazUTF8, FileUtil,
  // lcl
  Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Menus,
  Clipbrd,
  // SynEdit
  SynEdit,
  // IDEIntf
  IDECommands, MenuIntf, IDEWindowIntf, LazIDEIntf,
  IDEOptEditorIntf, IDEDialogs, IDEOptionsIntf, SimpleWebSrvOptionsFrame,
  SimpleWebSrvController, SimpleWebSrvAdd, SimpleWebSrvStrConsts;

const
  SimpleWebSrvWindowName = 'SimpleWebServerWindow';
type

  { TSimpleWebServerWindow }

  TSimpleWebServerWindow = class(TForm)
    AddButton: TButton;
    ConfigureButton: TButton;
    DeleteButton: TButton;
    DeleteSelectedButton: TButton;
    GetLocationsButton: TButton;
    ILProcesses: TImageList;
    ListeningEdit: TEdit;
    ListeningLabel: TLabel;
    LocationsListView: TListView;
    LocationsPopupMenu: TPopupMenu;
    LogSplitter: TSplitter;
    CopyLocationMenuItem: TMenuItem;
    CopyDirectoryPathMenuItem: TMenuItem;
    CopyOriginMenuItem: TMenuItem;
    CopyURLMenuItem: TMenuItem;
    MsgSplitter: TSplitter;
    OptionsPanel: TPanel;
    ServerLogGroupBox: TGroupBox;
    ServerLogSplitter: TSplitter;
    ServerLogSynEdit: TSynEdit;
    StartStopServerButton: TButton;
    procedure AddButtonClick(Sender: TObject);
    procedure ConfigureButtonClick(Sender: TObject);
    procedure CopyDirectoryPathMenuItemClick(Sender: TObject);
    procedure CopyLocationMenuItemClick(Sender: TObject);
    procedure CopyOriginMenuItemClick(Sender: TObject);
    procedure CopyURLMenuItemClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure LocationsListViewItemChecked(Sender: TObject; Item: TListItem);
    procedure LocationsListViewSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure LocationsPopupMenuPopup(Sender: TObject);
    procedure StartStopServerButtonClick(Sender: TObject);
  private
    function GetController: TSimpleWebServerController;
    procedure OnLocationsChanged(Sender: TObject);
    procedure OnServerLog(Sender: TObject; OutLines: TStrings);
    procedure OnStateChanged(Sender: TObject; Instance: TSWSInstance);
    procedure UpdateLocationsView;
    procedure UpdateButtons;
    function RowToControllerObj(Row: integer): TObject;
    function CaptionToControllerObj(s: string): TObject;
    procedure DeleteLocation(aCaption: string);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    property Controller: TSimpleWebServerController read GetController;
  end;

var
  SimpleWebServerWindow: TSimpleWebServerWindow;
  SimpleWebServerWindowCreator: TIDEWindowCreator; // set by Register
  ViewSimpleWebServerWindowCommand: TIDECommand; // set by Register

procedure ShowSimpleWebServerWindow(Sender: TObject);
procedure CreateSimpleWebServerWindow(Sender: TObject; aFormName: string;
                          var AForm: TCustomForm; DoDisableAutoSizing: boolean);

procedure Register;

implementation

const
  ServerPrefix = 'Port:';

{$R *.lfm}

procedure Register;
var
  CmdCatView: TIDECommandCategory;
begin
  SimpleWebServerController:=TSimpleWebServerController.Create(nil);
  SimpleWebServerController.Options.LoadSafe;

  CmdCatView:=IDECommandList.FindCategoryByName(CommandCategoryViewName);
  if CmdCatView=nil then
    raise Exception.Create('simplewebsrv: command category '+CommandCategoryViewName+' not found');

  // Windows - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  SimpleWebServerWindowCreator:=IDEWindowCreators.Add(SimpleWebSrvWindowName,
       @CreateSimpleWebServerWindow,nil,
       '20%','20%','+50%','+20%');

  // Windows - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ViewSimpleWebServerWindowCommand:=RegisterIDECommand(CmdCatView, 'SimpleWebServer',
    rsSWSTitle, CleanIDEShortCut, CleanIDEShortCut, nil, @ShowSimpleWebServerWindow);
  RegisterIDEMenuCommand(itmViewMainWindows, 'ViewSimpleWebServer',
    rsSWSTitle, nil, nil, ViewSimpleWebServerWindowCommand);

  // Options Frame - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  SimpleWebServerOptionID:=RegisterIDEOptionsEditor(GroupEnvironment,
      TSimpleWebSrvOptsFrame,SimpleWebServerOptionID)^.Index;
  SimpleWebServerController.Options.Apply;
  SimpleWebServerController.HookMacros;
end;

procedure ShowSimpleWebServerWindow(Sender: TObject);
begin
  if SimpleWebServerWindow=nil then
    IDEWindowCreators.ShowForm(SimpleWebServerWindowCreator.FormName,true)
  else
    IDEWindowCreators.ShowForm(SimpleWebServerWindow,true);
end;

procedure CreateSimpleWebServerWindow(Sender: TObject; aFormName: string;
  var AForm: TCustomForm; DoDisableAutoSizing: boolean);
begin
  if not SameText(aFormName,SimpleWebSrvWindowName) then begin
    debugln(['ERROR: CreateSimpleWebServerWindow: there is already a form with this name']);
    exit;
  end;
  IDEWindowCreators.CreateForm(AForm,TSimpleWebServerWindow,DoDisableAutoSizing,
    LazarusIDE.OwningComponent);
  AForm.Name:=aFormName;
end;

{ TSimpleWebServerWindow }

procedure TSimpleWebServerWindow.StartStopServerButtonClick(Sender: TObject);
begin
  case Controller.MainSrvState of
    swssNone: Controller.StartMainServer(true);
    swssStopping: ;
    swssStarting: ;
    swssRunning: Controller.StopMainServer(true);
  end;
end;

function TSimpleWebServerWindow.GetController: TSimpleWebServerController;
begin
  Result:=SimpleWebServerController;
end;

procedure TSimpleWebServerWindow.OnLocationsChanged(Sender: TObject);
begin
  UpdateLocationsView;
end;

procedure TSimpleWebServerWindow.OnServerLog(Sender: TObject; OutLines: TStrings
  );
var
  CaretWasAtEnd: Boolean;
begin
  ServerLogSynEdit.BeginUpdate(false);
  try
    CaretWasAtEnd:=ServerLogSynEdit.CaretY>=ServerLogSynEdit.Lines.Count;
    ServerLogSynEdit.Lines.AddStrings(OutLines);
    if CaretWasAtEnd then
      // auto scroll
      ServerLogSynEdit.CaretXY:=Point(1,ServerLogSynEdit.Lines.Count);
  finally
    ServerLogSynEdit.EndUpdate;
  end;
end;

procedure TSimpleWebServerWindow.OnStateChanged(Sender: TObject;
  Instance: TSWSInstance);
begin
  if Instance=Controller.MainSrvInstance then
    UpdateButtons;
end;

procedure TSimpleWebServerWindow.UpdateLocationsView;
var
  i, Row: Integer;
  Loc: TSWSLocation;
  Item: TListItem;
  Server: TSWSInstance;
begin
  LocationsListView.BeginUpdate;
  try
    Row:=0;
    for i:=0 to Controller.LocationCount-1 do
    begin
      Loc:=Controller.Locations[i];
      if LocationsListView.Items.Count>Row then
      begin
        Item:=LocationsListView.Items[Row];
        Item.SubItems[0]:=Loc.Path;
        Item.SubItems[1]:=Loc.Origin;
      end
      else begin
        Item:=LocationsListView.Items.Add;
        Item.SubItems.Add(Loc.Path);
        Item.SubItems.Add(Loc.Origin);
      end;
      Item.Caption:=Loc.Location;
      Item.Checked:=Loc.Enable;
      inc(Row);
    end;

    for i:=0 to Controller.ServerCount-1 do
    begin
      Server:=Controller.Servers[i];
      if Server=Controller.MainSrvInstance then continue;
      if LocationsListView.Items.Count>Row then
      begin
        Item:=LocationsListView.Items[Row];
        Item.SubItems[0]:=Server.PathUsed;
        Item.SubItems[1]:=Server.Origin;
      end
      else begin
        Item:=LocationsListView.Items.Add;
        Item.SubItems.Add(Server.Path);
        Item.SubItems.Add(Server.Origin);
      end;
      Item.Caption:=ServerPrefix+IntToStr(Server.Port);
      Item.Checked:=Server.State in [swssStarting,swssRunning];
      inc(Row);
    end;

    while LocationsListView.Items.Count>Row do
      LocationsListView.Items.Delete(LocationsListView.Items.Count-1);
  finally
    LocationsListView.EndUpdate;
  end;

  DeleteButton.Enabled:=LocationsListView.Selected<>nil;
end;

procedure TSimpleWebServerWindow.UpdateButtons;
begin
  case Controller.MainSrvState of
    swssNone: StartStopServerButton.Caption:=rsSWStartServer;
    swssStarting: ;
    swssRunning: StartStopServerButton.Caption:=rsSWStopServer;
    swssStopping: ;
  end;
  StartStopServerButton.Enabled:=Controller.MainSrvState in [swssNone,swssRunning];
end;

function TSimpleWebServerWindow.RowToControllerObj(Row: integer): TObject;
begin
  Result:=nil;
  if (Row<0) or (Row>=LocationsListView.Items.Count) then
    exit;
  Result:=CaptionToControllerObj(LocationsListView.Items[Row].Caption);
end;

function TSimpleWebServerWindow.CaptionToControllerObj(s: string): TObject;
var
  aPort: LongInt;
begin
  if LeftStr(s,length(ServerPrefix))=ServerPrefix then
  begin
    aPort:=StrToIntDef(copy(s,length(ServerPrefix)+1,5),-1);
    if (aPort>0) and (aPort<=65535) then
    begin
      Result:=Controller.FindServerWithPort(aPort);
      if Result<>nil then exit;
    end;
  end;

  Result:=Controller.FindLocation(s);
end;

procedure TSimpleWebServerWindow.DeleteLocation(aCaption: string);
var
  Obj: TObject;
  Server: TSWSInstance;
  r: Integer;
begin
  Obj:=CaptionToControllerObj(aCaption);
  if Obj is TSWSLocation then
  begin
    r:=IDEMessageDialog(rsSWDelete,
      Format(rsSWDeleteLocation, [aCaption]), mtConfirmation, [mbYes, mbNo]);
    if r=mrYes then
      Controller.DeleteLocation(aCaption);
  end else if Obj is TSWSInstance then
  begin
    Server:=TSWSInstance(Obj);
    r:=IDEMessageDialog(rsSWDelete,
      Format(rsSWDeleteServerAt, [aCaption]), mtConfirmation, [mbYes, mbNo]);
    if r=mrYes then
      Controller.StopServer(Server,true);
  end;
end;

constructor TSimpleWebServerWindow.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  SimpleWebServerWindow:=Self;
end;

destructor TSimpleWebServerWindow.Destroy;
begin
  inherited Destroy;
  SimpleWebServerWindow:=nil;
end;

procedure TSimpleWebServerWindow.FormCreate(Sender: TObject);
begin
  ServerLogSynEdit.Font.Name:=SynDefaultFontName;
  ServerLogSynEdit.Font.Height:=SynDefaultFontHeight;

  Controller.AddHandlerLocationsChanged(@OnLocationsChanged);
  Controller.AddHandlerServerLog(@OnServerLog);
  Controller.AddHandlerStateChanged(@OnStateChanged);

  // fetch existing log
  OnServerLog(Self,Controller.LogLines);

  UpdateButtons;
  UpdateLocationsView;

  Caption:=rsSWSTitle;
  ConfigureButton.Caption:=rsSWConfigure;
  AddButton.Caption:=rsSWAdd;
  DeleteButton.Caption:=rsSWDelete2;

  LocationsListView.Columns[0].Caption:=rsSWLocation;
  LocationsListView.Columns[1].Caption:=rsSWWorkingDirectory;
  LocationsListView.Columns[2].Caption:=rsSWOrigin;
  LocationsListView.Columns[3].Caption:=rsSWNote;

  CopyURLMenuItem.Caption:=rsSWCopyURL;
  CopyLocationMenuItem.Caption:=rsSWCopyLocation;
  CopyDirectoryPathMenuItem.Caption:=rsSWCopyWorkingDirectoryPath;
  CopyOriginMenuItem.Caption:=rsSWCopyOrigin;
end;

procedure TSimpleWebServerWindow.ConfigureButtonClick(Sender: TObject);
begin
  LazarusIDE.DoOpenIDEOptions(TSimpleWebSrvOptsFrame);
end;

procedure TSimpleWebServerWindow.AddButtonClick(Sender: TObject);
begin
  ShowAddSWSLocationDialog(Controller);
end;

procedure TSimpleWebServerWindow.CopyDirectoryPathMenuItemClick(Sender: TObject
  );
var
  LI: TListItem;
begin
  LI:=LocationsListView.Selected;
  if LI=nil then exit;
  Clipboard.AsText:=LI.SubItems[0];
end;

procedure TSimpleWebServerWindow.CopyLocationMenuItemClick(Sender: TObject);
var
  LI: TListItem;
begin
  LI:=LocationsListView.Selected;
  if LI=nil then exit;
  Clipboard.AsText:=LI.Caption;
end;

procedure TSimpleWebServerWindow.CopyOriginMenuItemClick(Sender: TObject);
var
  LI: TListItem;
begin
  LI:=LocationsListView.Selected;
  if LI=nil then exit;
  Clipboard.AsText:=LI.SubItems[1];
end;

procedure TSimpleWebServerWindow.CopyURLMenuItemClick(Sender: TObject);
var
  LI: TListItem;
  Obj: TObject;
  Server: TSWSInstance;
  URL: String;
begin
  LI:=LocationsListView.Selected;
  if LI=nil then exit;
  Obj:=CaptionToControllerObj(LI.Caption);
  if Obj is TSWSLocation then
  begin
    URL:=Controller.GetURLWithLocation(TSWSLocation(Obj),'');
  end else if Obj is TSWSInstance then
  begin
    Server:=TSWSInstance(Obj);
    URL:=Controller.GetURLWithServer(Server,'');
  end;
  Clipboard.AsText:=URL;
end;

procedure TSimpleWebServerWindow.DeleteButtonClick(Sender: TObject);
var
  LI: TListItem;
begin
  LI:=LocationsListView.Selected;
  if LI=nil then exit;
  DeleteLocation(LI.Caption);
end;

procedure TSimpleWebServerWindow.FormDestroy(Sender: TObject);
begin
  Controller.RemoveAllHandlersOfObject(Self);
end;

procedure TSimpleWebServerWindow.LocationsListViewItemChecked(Sender: TObject;
  Item: TListItem);
var
  Loc: TSWSLocation;
  Obj: TObject;
begin
  Obj:=CaptionToControllerObj(Item.Caption);
  if Obj is TSWSLocation then
  begin
    Loc:=TSWSLocation(Obj);
    Controller.EnableLocation(Loc.Location,Item.Checked);
  end else if Obj is TSWSInstance then
  begin
    Item.Checked:=true;
  end;
end;

procedure TSimpleWebServerWindow.LocationsListViewSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  DeleteButton.Enabled:=LocationsListView.Selected<>nil;
  if Item=nil then ;
  if Selected then ;
end;

procedure TSimpleWebServerWindow.LocationsPopupMenuPopup(Sender: TObject);
var
  LI: TListItem;
  Enable: Boolean;
begin
  LI:=LocationsListView.Selected;
  Enable:=LI<>nil;
  CopyURLMenuItem.Enabled:=Enable;
  CopyLocationMenuItem.Enabled:=Enable;
  CopyDirectoryPathMenuItem.Enabled:=Enable;
  CopyOriginMenuItem.Enabled:=Enable;
end;

end.