(* Tux Commander - UFileAssoc - File Association system objects and functions Copyright (C) 2007 Tomas Bzatek 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 = ''; ConstFTAMetaFile = ''; {$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'} var FolderIcon, FileIcon, UpDirIcon, SymLinkEmblem, FolderIconLnk, FileIconLnk, FolderIconCached, FileIconCached, FolderIconLnkCached, FileIconLnkCached: TGDKPixbuf; MounterHDD, MounterRemovable, MounterFloppy, MounterCD, MounterNetwork: TGDKPixbuf; StockLock16, StockLock48: TGDKPixbuf; ArchiveIcon, ArchiveIconLnk: 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); 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 := 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 := 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.