path: root/UFileAssoc.pas

(*
    Tux Commander - UFileAssoc - File Association system objects and functions
    Copyright (C) 2007 Tomas Bzatek <tbzatek@users.sourceforge.net>
    Check for updates on tuxcmd.sourceforge.net

    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, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)
unit UFileAssoc;

interface

uses Classes, SysUtils, StrUtils, GTKPixbuf, GTKClasses, GTKUtils, UEngines, UVFSCore, UCoreUtils;

type TAssocAction = class
       public
         ActionName, ActionCommand: string;
         AutodetectGUI, RunInTerminal: boolean;
         constructor Create;
     end;

     TFileAssoc = class
       public
         Extensions: TOpenStringArray;
         FileTypeName, FileTypeIcon, ColorString: string;
         DefaultAction: integer;
         ActionList: TList;
         Pixmap, LnkPixmap: TGDKPixbuf;
         constructor Create;
         destructor Destroy; override;
     end;

const ConstFTAMetaDirectory = '<directory>';
      ConstFTAMetaFile = '<file>';

{$I 'pixmaps/emblem_symbolic_link_png.inc'}
{$I 'pixmaps/gnome_dev_cdrom_16_png.inc'}
{$I 'pixmaps/gnome_dev_floppy_16_png.inc'}
{$I 'pixmaps/gnome_dev_harddisk_16_png.inc'}
{$I 'pixmaps/gnome_dev_removable_usb_16_png.inc'}
{$I 'pixmaps/gnome_mime_application_zip_16_png.inc'}
{$I 'pixmaps/gnome_mime_x_directory_smb_share_16_png.inc'}
{$I 'pixmaps/stock_folder_16_png.inc'}
{$I 'pixmaps/stock_lock_16_png.inc'}
{$I 'pixmaps/stock_lock_48_png.inc'}
{$I 'pixmaps/stock_new_16_png.inc'}
{$I 'pixmaps/stock_up_one_dir_16_png.inc'}
{$I 'pixmaps/tuxcmd_16_png.inc'}
{$I 'pixmaps/tuxcmd_24_png.inc'}
{$I 'pixmaps/tuxcmd_32_png.inc'}
{$I 'pixmaps/tuxcmd_48_png.inc'}
{$I 'pixmaps/tuxcmd_64_png.inc'}
{$I 'pixmaps/tuxcmd_128_png.inc'}





var FolderIcon, FileIcon, UpDirIcon, SymLinkEmblem, FolderIconLnk, FileIconLnk,
    FolderIconCached, FileIconCached, FolderIconLnkCached, FileIconLnkCached: TGDKPixbuf;
    MounterHDD, MounterRemovable, MounterFloppy, MounterCD, MounterNetwork: TGDKPixbuf;
    StockLock16, StockLock48: TGDKPixbuf;
    ArchiveIcon, ArchiveIconLnk: TGDKPixbuf;
    AppIcon16, AppIcon24, AppIcon32, AppIcon48, AppIcon64, AppIcon128: TGDKPixbuf;


procedure LoadIcons;
function FindVFSPlugin(Filename: string): TVFSPlugin;
function FindAssoc(Filename: string): TFileAssoc;
procedure AssignFileType(Item: PDataItem);
procedure RecreateIcons(List: TList; const FreePixmaps: boolean = True);
procedure RemoveIconRefs(List: TList; FreeIt: boolean);
procedure AddDefaultItems(List: TList);

implementation

uses GTKForms, UConfig, UCore;


(********************************************************************************************************************************)
(********************************************************************************************************************************)
(********************************************************************************************************************************)
constructor TFileAssoc.Create;
begin
  ActionList := TList.Create;
  DefaultAction := 0;
  FileTypeIcon := '';
  SetLength(Extensions, 0);
  FileTypeName := '';
  ColorString := '';
  Pixmap := TGDKPixbuf.Create(nil);
end;

destructor TFileAssoc.Destroy;
var i: integer;
begin
  try
    if Assigned(ActionList) and (ActionList.Count > 0) then
      for i := ActionList.Count - 1 downto 0 do
        TAssocAction(ActionList[i]).Free;
    ActionList.Clear;
    ActionList.Free;
//    Pixmap.Free;
  except
  end;
end;

(********************************************************************************************************************************)
constructor TAssocAction.Create;
begin
  RunInTerminal := False;
  AutodetectGUI := True;
end;

(********************************************************************************************************************************)
procedure LoadIcons;
begin
  FolderIcon := TGDKPixbuf.Create(Application);
  FolderIcon.LoadFromInline(@stock_folder_16_png[1]);
  FolderIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal);
  FileIcon := TGDKPixbuf.Create(Application);
  FileIcon.LoadFromInline(@stock_new_16_png[1]);
  FileIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal);
  UpDirIcon := TGDKPixbuf.Create(Application);
  UpDirIcon.LoadFromInline(@stock_up_one_dir_16_png[1]);
  UpDirIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal);
  SymLinkEmblem := TGDKPixbuf.Create(Application);
  SymLinkEmblem.LoadFromInline(@emblem_symbolic_link_png[1]);
  FolderIconLnk := TGDKPixbuf.Create(Application);
  FolderIconLnk.FPixbuf := FolderIcon.Copy;
  FolderIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FolderIconLnk.Width - SymLinkEmblem.Width, FolderIconLnk.Height - SymLinkEmblem.Height);
  FileIconLnk := TGDKPixbuf.Create(Application);
  FileIconLnk.FPixbuf := FileIcon.Copy;
  FileIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FileIconLnk.Width - SymLinkEmblem.Width, FileIconLnk.Height - SymLinkEmblem.Height);
  FolderIconCached := FolderIcon;
  FileIconCached := FileIcon;
  FolderIconLnkCached := FolderIconLnk;
  FileIconLnkCached := FileIconLnk;
  MounterHDD := TGDKPixbuf.Create(Application);
  MounterHDD.LoadFromInline(@gnome_dev_harddisk_16_png[1]);
  MounterRemovable := TGDKPixbuf.Create(Application);
  MounterRemovable.LoadFromInline(@gnome_dev_removable_usb_16_png[1]);
  MounterFloppy := TGDKPixbuf.Create(Application);
  MounterFloppy.LoadFromInline(@gnome_dev_floppy_16_png[1]);
  MounterCD := TGDKPixbuf.Create(Application);
  MounterCD.LoadFromInline(@gnome_dev_cdrom_16_png[1]);
  MounterNetwork := TGDKPixbuf.Create(Application);
  MounterNetwork.LoadFromInline(@gnome_mime_x_directory_smb_share_16_png[1]);
  StockLock16 := TGDKPixbuf.Create(Application);
  StockLock16.LoadFromInline(@stock_lock_16_png[1]);
  StockLock48 := TGDKPixbuf.Create(Application);
  StockLock48.LoadFromInline(@stock_lock_48_png[1]);
  ArchiveIcon := TGDKPixbuf.Create(Application);
  ArchiveIcon.LoadFromInline(@gnome_mime_application_zip_16_png[1]);
  ArchiveIcon.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal);
  ArchiveIconLnk := TGDKPixbuf.Create(Application);
  ArchiveIconLnk.FPixbuf := ArchiveIcon.Copy;
  ArchiveIconLnk.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, FolderIconLnk.Width - SymLinkEmblem.Width, FolderIconLnk.Height - SymLinkEmblem.Height);

  AppIcon16 := TGDKPixbuf.Create(Application);
  AppIcon16.LoadFromInline(@tuxcmd_16_png[1]);
  AppIcon24 := TGDKPixbuf.Create(Application);
  AppIcon24.LoadFromInline(@tuxcmd_24_png[1]);
  AppIcon32 := TGDKPixbuf.Create(Application);
  AppIcon32.LoadFromInline(@tuxcmd_32_png[1]);
  AppIcon48 := TGDKPixbuf.Create(Application);
  AppIcon48.LoadFromInline(@tuxcmd_48_png[1]);
  AppIcon64 := TGDKPixbuf.Create(Application);
  AppIcon64.LoadFromInline(@tuxcmd_64_png[1]);
  AppIcon128 := TGDKPixbuf.Create(Application);
  AppIcon128.LoadFromInline(@tuxcmd_128_png[1]);
end;

(********************************************************************************************************************************)
function FindVFSPlugin(Filename: string): TVFSPlugin;
var Ext, s: string;
    b: boolean;
    i, j, MaxFound: integer;
begin
  Result := nil;
  MaxFound := 0;
  if (Pos('.', Filename) > 0) and (LastDelimiter('.', Filename) < Length(Filename)) then begin
    Ext := WideUpperCase(Trim(Copy(Filename, Pos('.', Filename), Length(Filename) - Pos('.', Filename) + 1)));
    if PluginList.Count > 0 then
      for i := 0 to PluginList.Count - 1 do
        with TVFSPlugin(PluginList[i]) do
          if Length(Extensions) > 0 then begin
            b := False;
            s := '';
            for j := 0 to Length(Extensions) - 1 do begin
              s := ANSIUpperCase(IncludeLeadingDot(Extensions[j]));
              if Length(Ext) = Length(s)
                then b := (Ext = s) and (Length(s) > MaxFound)
                else b := (Pos(s, Ext) > 0) and (RightStr(Ext, Length(s)) = s) and (Length(s) > MaxFound);
              if b then Break;
            end;
            if b then begin
              Result := TVFSPlugin(PluginList[i]);
              MaxFound := Length(s);
            end;
          end;
  end;
end;

function FindAssoc(Filename: string): TFileAssoc;
var Ext, s: string;
    b: boolean;
    i, j, MaxFound: integer;
begin
  Result := nil;
  MaxFound := 0;
  if (Pos('.', Filename) > 0) and (LastDelimiter('.', Filename) < Length(Filename)) then begin
    Ext := WideUpperCase(Trim(Copy(Filename, Pos('.', Filename), Length(Filename) - Pos('.', Filename) + 1)));
    if AssocList.Count > 0 then
      for i := 0 to AssocList.Count - 1 do
        with TFileAssoc(AssocList[i]) do
          if Length(Extensions) > 0 then begin
            b := False;
            s := '';
            for j := 0 to Length(Extensions) - 1 do begin
              s := ANSIUpperCase(IncludeLeadingDot(Extensions[j]));
              if Length(Ext) = Length(s)
                then b := (Ext = s) and (Length(s) > MaxFound)
                else b := (Pos(s, Ext) > 0) and (RightStr(Ext, Length(s)) = s) and (Length(s) > MaxFound);
              if b then Break;
            end;
            if b then begin
              Result := TFileAssoc(AssocList[i]);
              MaxFound := Length(s);
            end;
          end;
  end;
end;

procedure AssignFileType(Item: PDataItem);
var AColor: TGDKColor;
    Plugin: TVFSPlugin;
    Assoc: TFileAssoc;
begin
  with PDataItem(Item)^ do begin
    ItemColor := nil;
    if IsLnk and (not ConfLinkItemDefaultColors) then ItemColor := LinkItemGDKColor else
    if IsDotFile and (not ConfDotFileItemDefaultColors) then ItemColor := DotFileItemGDKColor;
    if IsDir then begin
      if IsLnk then Icon := FolderIconLnkCached.FPixbuf
               else Icon := FolderIconCached.FPixbuf; 
    end else
    begin
      if not IsLnk then Icon := FileIconCached.FPixbuf
                   else Icon := FileIconLnkCached.FPixbuf;
      if (Pos('.', FName) > 1) and (LastDelimiter('.', FName) < Length(FName)) then begin
        Plugin := FindVFSPlugin(FName);
        Assoc := FindAssoc(FName);

        //  Asssign icon and color
        if Plugin <> nil then begin
          if IsLnk then Icon := ArchiveIconLnk.FPixbuf
                   else Icon := ArchiveIcon.FPixbuf;
        end else
        if Assoc <> nil then begin
          if Assigned(Assoc.Pixmap) then begin
            if IsLnk and Assigned(Assoc.LnkPixmap) and Assigned(Assoc.LnkPixmap.FPixbuf)
              then Icon := Assoc.LnkPixmap.FPixbuf
              else Icon := Assoc.Pixmap.FPixbuf;
          end;
          if ItemColor = nil then begin
            if (Assoc.ColorString = '') or (not StringToGDKColor(Assoc.ColorString, AColor))
                then ItemColor := NormalItemGDKColor
                else ItemColor := GDKColorToPGdkColor(AColor);
          end;
        end;
      end;
    end;
  end;
end;

(********************************************************************************************************************************)
procedure RecreateIcons(List: TList; const FreePixmaps: boolean = True);
var i: integer;
    b: boolean;
begin
  if Assigned(List) and (List.Count > 0) then
    for i := 0 to List.Count - 1 do
      if Assigned(List[i]) and (TObject(List[i]) is TFileAssoc) then
        with TFileAssoc(List[i]) do begin
          //  Destroy old objects
          if (Pixmap <> FileIcon) and (Pixmap <> FileIconLnk) and (Pixmap <> UpDirIcon) and (Pixmap <> FolderIcon) and
             (Pixmap <> FileIconCached) and (Pixmap <> FileIconLnkCached) and (Pixmap <> FolderIconCached) and (Pixmap <> FolderIconLnkCached) and
             (Pixmap <> FolderIconLnk) and Assigned(Pixmap) and Assigned(Pixmap.FPixbuf) then
          begin
            if FreePixmaps then Pixmap.Free;
            Pixmap := nil;
          end;
          if (LnkPixmap <> FileIcon) and (LnkPixmap <> FileIconLnk) and (LnkPixmap <> UpDirIcon) and (LnkPixmap <> FolderIcon) and
             (Pixmap <> FileIconCached) and (Pixmap <> FileIconLnkCached) and (Pixmap <> FolderIconCached) and (Pixmap <> FolderIconLnkCached) and
             (LnkPixmap <> FolderIconLnk) and Assigned(LnkPixmap) and Assigned(LnkPixmap.FPixbuf) then
          begin
            if FreePixmaps then LnkPixmap.Free;
            LnkPixmap := nil;
          end;
          //  Load / Assign icon
          b := FileExists(FileTypeIcon);
          if b then begin
            if not Assigned(Pixmap) then Pixmap := TGDKPixbuf.Create(nil);
            b := Pixmap.LoadFromFile(FileTypeIcon);
            if b then Pixmap.ScaleSimple(ConfRowHeightReal, ConfRowHeightReal);
          end;
          if not b then
            if FileTypeName = ConstFTAMetaDirectory then Pixmap := FolderIcon else
            if FileTypeName = ConstFTAMetaFile then Pixmap := FileIcon
            else Pixmap := FileIconCached;
          //  Create Link overelay
          if Assigned(Pixmap) and Assigned(Pixmap.FPixbuf) and Assigned(SymLinkEmblem) then begin
            LnkPixmap := TGDKPixbuf.Create(nil);
            LnkPixmap.FPixbuf := Pixmap.Copy;
            LnkPixmap.CopyArea(SymLinkEmblem, 0, 0, SymLinkEmblem.Width, SymLinkEmblem.Height, LnkPixmap.Width - SymLinkEmblem.Width, LnkPixmap.Height - SymLinkEmblem.Height);
          end else LnkPixmap := Pixmap;

          if FileTypeName = ConstFTAMetaDirectory then begin
            FolderIconCached := Pixmap;
            FolderIconLnkCached := LnkPixmap;
          end;
          if FileTypeName = ConstFTAMetaFile then begin
            FileIconCached := Pixmap;
            FileIconLnkCached := LnkPixmap;
          end;
        end;
end;

(********************************************************************************************************************************)
procedure RemoveIconRefs(List: TList; FreeIt: boolean);
var i: integer;
begin
  if Assigned(List) and (List.Count > 0) then
    for i := 0 to List.Count - 1 do
      if Assigned(List[i]) and (TObject(List[i]) is TFileAssoc) then
        with TFileAssoc(List[i]) do begin
          if FreeIt and Assigned(Pixmap) then Pixmap.Free;
          Pixmap := nil;
          if FreeIt and Assigned(LnkPixmap) then LnkPixmap.Free;
          LnkPixmap := nil;
        end;
end;

(********************************************************************************************************************************)
procedure AddDefaultItems(List: TList);
var Item: TFileAssoc;
    i: integer;
    Found: boolean; 
begin
  //  Add default directory item
  try
    Found := False;
    if List.Count > 0 then
      for i := 0 to List.Count - 1 do
        if TFileAssoc(List[i]).FileTypeName = ConstFTAMetaDirectory then begin
          Found := True;
          Break;
        end;
    if not Found then begin
      Item := TFileAssoc.Create;
      Item.FileTypeName := ConstFTAMetaDirectory;
      SetLength(Item.Extensions, 0);
      Item.FileTypeIcon := '';
      Item.ColorString := '';
      Item.DefaultAction := 0;
      Item.ActionList := TList.Create;
      Item.Pixmap := nil;
      Item.LnkPixmap := nil;
      List.Insert(0, Item);
    end;
  except end;

  //  Add default file item
  try
    Found := False;
    if List.Count > 0 then
      for i := 0 to List.Count - 1 do
        if TFileAssoc(List[i]).FileTypeName = ConstFTAMetaFile then begin
          Found := True;
          Break;
        end;
    if not Found then begin
      Item := TFileAssoc.Create;
      Item.FileTypeName := ConstFTAMetaFile;
      SetLength(Item.Extensions, 0);
      Item.FileTypeIcon := '';
      Item.ColorString := '';
      Item.DefaultAction := 0;
      Item.ActionList := TList.Create;
      Item.Pixmap := nil;
      Item.LnkPixmap := nil;
      List.Insert(0, Item);
    end;
  except end;
end;

(********************************************************************************************************************************)

end.