doublecmd/components/KASToolBar/kaspathedit.pas

{
   Double Commander Components
   -------------------------------------------------------------------------
   Path edit class with auto complete feature

   Copyright (C) 2012-2022 Alexander Koblov (alexx2000@mail.ru)

   This program is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as
   published by the Free Software Foundation; either version 2 of the
   License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program. If not, see <http://www.gnu.org/licenses/>.
}

unit KASPathEdit;

{$mode delphi}
{$interfaces corba}
{$IF DEFINED(LCLCOCOA)}
{$modeswitch objectivec1}
{$ENDIF}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ShellCtrls, LCLType, LCLVersion
{$IF DEFINED(LCLCOCOA)}
  , CocoaAll, CocoaWindows
{$ENDIF}
  ;

type

  { TKASPathEditGetFilesFunc }

  TKASPathEditGetFilesFunc = Procedure (
    const path: String;
    const types: TObjectTypes;
    const sort: TFileSortType;
    files: TStringList );

  { IKASPathEditMate }

  IKASPathEditMate = interface
    function getFilesAtPath(
      const path: String;
      const types: TObjectTypes;
      const sort: TFileSortType ): TStringList;
  end;

  { TKASPathEdit }

  TKASPathEdit = class(TEdit)
  private
    FMate: IKASPathEditMate;
    FKeyDown: Word;
    FBasePath: String;
    FListBox: TListBox;
    FPanel: THintWindow;
    FAutoComplete: Boolean;
    FGetFilesFunc: TKASPathEditGetFilesFunc;
    FStringList: TStringList;
    FObjectTypes: TObjectTypes;
    FFileSortType: TFileSortType;
  private
    procedure setTextAndSelect( newText:String );
    procedure handleSpecialKeys( var Key: Word );
    procedure handleUpKey;
    procedure handleDownKey;
    procedure AutoComplete(const Path: String);
    procedure SetObjectTypes(const AValue: TObjectTypes);
    procedure FormChangeBoundsEvent(Sender: TObject);
    procedure ListBoxClick(Sender: TObject);
    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    function isShowingListBox(): Boolean; inline;
    procedure ShowListBox;
    procedure HideListBox;
  protected
{$IF DEFINED(LCLWIN32)}
    procedure CreateWnd; override;
{$ENDIF}
{$IF DEFINED(LCLCOCOA)}
    procedure TextChanged; override;
{$ENDIF}
    procedure DoExit; override;
    procedure VisibleChanged; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); override;
  public
    onKeyESCAPE: TNotifyEvent;
    onKeyRETURN: TNotifyEvent;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property GetFilesFunc: TKASPathEditGetFilesFunc read FGetFilesFunc write FGetFilesFunc;
    property Mate: IKASPathEditMate read FMate write FMate;
  published
    property ObjectTypes: TObjectTypes read FObjectTypes write SetObjectTypes;
    property FileSortType: TFileSortType read FFileSortType write FFileSortType;
  end;

procedure Register;

implementation

uses
  LazUTF8, Math, LazFileUtils, Masks
  {$IF DEFINED(LCLWIN32)}
  , ComObj
  {$ENDIF}
  {$IF DEFINED(MSWINDOWS)}
  , Windows
  {$ENDIF}
  ;

{$IF DEFINED(LCLWIN32)}

const
  SHACF_AUTOAPPEND_FORCE_ON  = $40000000;
  SHACF_AUTOSUGGEST_FORCE_ON = $10000000;
  SHACF_FILESYS_ONLY         = $00000010;
  SHACF_FILESYS_DIRS         = $00000020;

function SHAutoComplete(hwndEdit: HWND; dwFlags: DWORD): HRESULT; stdcall; external 'shlwapi.dll';

function SHAutoCompleteX(hwndEdit: HWND; ObjectTypes: TObjectTypes): Boolean;
var
  dwFlags: DWORD;
begin
  if (ObjectTypes = []) then Exit(False);
  dwFlags := SHACF_AUTOAPPEND_FORCE_ON or SHACF_AUTOSUGGEST_FORCE_ON;
  if (otNonFolders in ObjectTypes) then
    dwFlags := dwFlags or SHACF_FILESYS_ONLY
  else if (otFolders in ObjectTypes) then
    dwFlags := dwFlags or SHACF_FILESYS_DIRS;
  Result:= (SHAutoComplete(hwndEdit, dwFlags) = 0);
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents('KASComponents', [TKASPathEdit]);
end;

{ TKASPathEdit }

function TKASPathEdit.isShowingListBox(): Boolean;
begin
  Result:= FPanel<>nil;
end;

procedure TKASPathEdit.AutoComplete(const Path: String);
{$IF LCL_FULLVERSION < 4990000}
const
  AFlags: array[Boolean] of TMaskOptions = (
    [moDisableSets], [moDisableSets, moCaseSensitive]
  );
{$ENDIF}
var
  I: Integer;
  AMask: TMask;
  BasePath: String;
begin
  FListBox.Clear;
  if Pos(PathDelim, Path) = 0 then
    HideListBox
  else begin
    BasePath:= ExtractFilePath(Path);
    if CompareFilenames(FBasePath, BasePath) <> 0 then
    begin
      FreeAndNil(FStringList);
      FBasePath:= BasePath;
      if Assigned(FMate) then
        FStringList:= FMate.getFilesAtPath(BasePath, FObjectTypes, FFileSortType);
    end;
    if (FStringList=nil) or (FStringList.Count<=0) then
      Exit;
    FListBox.Items.BeginUpdate;
    try
      // Check mask and make absolute file name
      AMask:= TMask.Create(ExtractFileName(Path) + '*',
{$IF LCL_FULLVERSION < 4990000}
                           AFlags[FileNameCaseSensitive]
{$ELSE}
                           FileNameCaseSensitive
{$ENDIF}
        );
      for I:= 0 to FStringList.Count - 1 do
      begin
        if AMask.Matches(FStringList[I]) then
          FListBox.Items.Add(BasePath + FStringList[I]);
      end;
      AMask.Free;
    finally
      FListBox.Items.EndUpdate;
    end;
    if FListBox.Items.Count = 0 then HideListBox;
    if FListBox.Items.Count > 0 then
    begin
      ShowListBox;
      // Calculate ListBox height
      with FListBox.ItemRect(0) do
      I:= Bottom - Top; // TListBox.ItemHeight sometimes don't work under GTK2
      with FListBox do
      begin
{$IF NOT DEFINED(LCLCOCOA)}
        if Items.Count = 1 then
          FPanel.ClientHeight:= Self.Height
        else
          FPanel.ClientHeight:= I * IfThen(Items.Count > 10, 11, Items.Count + 1);
{$ELSE}
        FPanel.ClientHeight:= I * IfThen(Items.Count > 10, 11, Items.Count + 1) + trunc(i/2);
{$ENDIF}
      end;
    end;
  end;
end;

procedure TKASPathEdit.SetObjectTypes(const AValue: TObjectTypes);
begin
  if FObjectTypes = AValue then Exit;
  FObjectTypes:= AValue;
{$IF DEFINED(LCLWIN32)}
  if HandleAllocated then RecreateWnd(Self);
  if FAutoComplete then
{$ENDIF}
  FAutoComplete:= (FObjectTypes <> []);
end;

procedure TKASPathEdit.FormChangeBoundsEvent(Sender: TObject);
begin
  HideListBox;
end;

procedure TKASPathEdit.ListBoxClick(Sender: TObject);
begin
  if FListBox.ItemIndex >= 0 then
  begin
    setTextAndSelect( FListBox.Items[FListBox.ItemIndex] );
    HideListBox;
    SetFocus;
  end;
end;

procedure TKASPathEdit.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FListBox.ItemIndex:= FListBox.ItemAtPos(Classes.Point(X, Y), True);
end;

{$IF DEFINED(LCLCOCOA)}
procedure cocoaNeedMouseEvent( hintWindow: THintWindow );
var
  cnt: TCocoaWindowContent;
begin
  cnt:= TCocoaWindowContent( hintWindow.Handle );
  cnt.window.setIgnoresMouseEvents( false );
end;
{$ENDIF}

procedure TKASPathEdit.ShowListBox;
begin
  if not isShowingListBox() then
  begin
    FPanel:= THintWindow.Create(Self);
{$IF DEFINED(LCLCOCOA)}
    cocoaNeedMouseEvent(FPanel);
{$ENDIF}
    FPanel.Color:= clDefault;
    FListBox.Parent:= FPanel;

    with Parent.ClientToScreen(CLasses.Point(Left, Top)) do
    begin
      FPanel.Left:= X;
      FPanel.Top:= Y + Height;
    end;

    FPanel.Width:= Width;
    FPanel.Visible:= True;

    Application.AddOnDeactivateHandler(FormChangeBoundsEvent, True);
    GetParentForm(Self).AddHandlerOnChangeBounds(FormChangeBoundsEvent, True);
  end;
end;

procedure TKASPathEdit.HideListBox;
begin
  if isShowingListBox() then
  begin
    FPanel.Visible:= False;
    FListBox.Parent:= nil;
    FreeAndNil(FPanel);
    Application.RemoveOnDeactivateHandler(FormChangeBoundsEvent);
    GetParentForm(Self).RemoveHandlerOnChangeBounds(FormChangeBoundsEvent);
  end;
end;

{$IF DEFINED(LCLWIN32)}

procedure TKASPathEdit.CreateWnd;
begin
  inherited CreateWnd;
  FAutoComplete:= not SHAutoCompleteX(Handle, FObjectTypes);
end;

{$ENDIF}


{$IF DEFINED(LCLCOCOA)}
procedure TKASPathEdit.TextChanged;
begin
  Inherited;
  if not Modified then
    Exit;
  if FAutoComplete then
    AutoComplete(Text);
end;
{$ENDIF}


procedure TKASPathEdit.setTextAndSelect( newText:String );
var
  start: Integer;
begin
  if Pos(Text,newText) > 0 then
    start:= UTF8Length(Text)
  else
    start:= UTF8Length(ExtractFilePath(Text));
  Text:= newText;
  SelStart:= start;
  SelLength:= UTF8Length(Text)-SelStart;
end;

procedure TKASPathEdit.DoExit;
begin
  HideListBox;
  inherited DoExit;
end;

procedure TKASPathEdit.VisibleChanged;
begin
  FBasePath:= EmptyStr;
  inherited VisibleChanged;
end;

procedure TKASPathEdit.handleSpecialKeys( var Key: Word );
begin
  if isShowingListBox() then begin
    HideListBox;
    Key:= 0;
  end else begin
    if Key=VK_ESCAPE then begin
      if Assigned(onKeyESCAPE) then begin
        onKeyESCAPE( self );
        Key:= 0;
      end;
    end else begin
      if Assigned(onKeyRETURN) then begin
        onKeyRETURN( self );
        Key:= 0;
      end;
    end;
  end;
end;

procedure TKASPathEdit.handleUpKey;
begin
    if FListBox.ItemIndex = -1 then
      FListBox.ItemIndex:= FListBox.Items.Count - 1
    else if FListBox.ItemIndex - 1 < 0 then
      FListBox.ItemIndex:= - 1
    else
      FListBox.ItemIndex:= FListBox.ItemIndex - 1;

    if FListBox.ItemIndex >= 0 then
      setTextAndSelect( FListBox.Items[FListBox.ItemIndex] )
    else
      setTextAndSelect( ExtractFilePath(Text) );
end;

procedure TKASPathEdit.handleDownKey;
begin
    if FListBox.ItemIndex + 1 >= FListBox.Items.Count then
      FListBox.ItemIndex:= -1
    else if FListBox.ItemIndex = -1 then
      FListBox.ItemIndex:= IfThen(FListBox.Items.Count > 0, 0, -1)
    else
      FListBox.ItemIndex:= FListBox.ItemIndex + 1;

    if FListBox.ItemIndex >= 0 then
      setTextAndSelect( FListBox.Items[FListBox.ItemIndex] )
    else
      setTextAndSelect( ExtractFilePath(Text) );
end;

procedure TKASPathEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FKeyDown:= Key;
  case Key of
    VK_ESCAPE,
    VK_RETURN,
    VK_SELECT:
      handleSpecialKeys( Key );
    VK_UP:
      if isShowingListBox() then
      begin
        Key:= 0;
        handleUpKey();
      end;
    VK_DOWN:
      if isShowingListBox() then
      begin
        Key:= 0;
        handleDownKey();
      end;
  end;

  inherited KeyDown(Key, Shift);
{$IFDEF LCLGTK2}
  // Workaround for GTK2 - up and down arrows moving through controls.
  if Key in [VK_UP, VK_DOWN] then Key:= 0;
{$ENDIF}
end;

procedure TKASPathEdit.KeyUpAfterInterface(var Key: Word; Shift: TShiftState);
begin
{$IF not DEFINED(LCLCOCOA)}
  if (FKeyDown = Key) and FAutoComplete and not (Key in [VK_ESCAPE, VK_RETURN, VK_SELECT, VK_UP, VK_DOWN]) then
  begin
    if Modified then
    begin
      Modified:= False;
      AutoComplete(Text);
    end;
  end;
{$ENDIF}
  inherited KeyUpAfterInterface(Key, Shift);
{$IF DEFINED(LCLWIN32)}
  // Windows auto-completer eats the TAB so LCL doesn't get it and doesn't move to next control.
  if not FAutoComplete and (Key = VK_TAB) then
    GetParentForm(Self).SelectNext(Self, True, True);
{$ENDIF}
end;

constructor TKASPathEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FListBox:= TListBox.Create(Self);
  FListBox.TabStop:= False;
  FListBox.Align:= alClient;
  FListBox.ParentFont:= False;
  FListBox.ClickOnSelChange:= False;
  FListBox.OnClick:= ListBoxClick;
  FListBox.OnMouseMove:= ListBoxMouseMove;

  FAutoComplete:= True;
  FFileSortType:= fstFoldersFirst;
  FObjectTypes:= [otNonFolders, otFolders];
end;

destructor TKASPathEdit.Destroy;
begin
  inherited Destroy;
  FStringList.Free;
end;

end.