diff --git a/comp/src/gb.form/.project b/comp/src/gb.form/.project index a7f70fe25..0b77a37c6 100644 --- a/comp/src/gb.form/.project +++ b/comp/src/gb.form/.project @@ -1,6 +1,6 @@ # Gambas Project File 3.0 Title=More controls for graphical components -Startup=FTestTabPanel +Startup=FTestThumbnailer Icon=.hidden/icon.png Version=3.17.90 VersionFile=1 diff --git a/comp/src/gb.form/.src/File/CTaskPreview.class b/comp/src/gb.form/.src/File/CTaskPreview.class index 5643f01ba..4f9dff5ab 100644 --- a/comp/src/gb.form/.src/File/CTaskPreview.class +++ b/comp/src/gb.form/.src/File/CTaskPreview.class @@ -12,13 +12,15 @@ Private $sCache As String Public Sub _new(sDir As String, iSize As Integer, iMaxFileSize As Integer, aPreview As String[], sTempDir As String) - $sDir = sDir - $iSize = iSize - $iMaxFileSize = iMaxFileSize - If $iMaxFileSize = 0 Then $iMaxFileSize = 4194304 - $aPreview = aPreview - $sCache = sTempDir &/ "gb.form/thumbnails" - Main.MkDir($sCache) + ' $sDir = sDir + ' $iSize = iSize + ' $iMaxFileSize = iMaxFileSize + ' If $iMaxFileSize = 0 Then $iMaxFileSize = 4194304 + ' $aPreview = aPreview + ' $sCache = sTempDir &/ "gb.form/thumbnails" + ' Main.MkDir($sCache) + + End diff --git a/comp/src/gb.form/.src/File/Disks/DiskPanel.class b/comp/src/gb.form/.src/File/Disks/DiskPanel.class new file mode 100644 index 000000000..531b65d6f --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/DiskPanel.class @@ -0,0 +1,66 @@ +' Gambas class file + +Export +Inherits UserControl +Private $hView As New ColumnView(Me) As "View" +Private $hBookmarks As New CBookmarkList + +Public Sub _new() + Dim hb As CBookmark + Component.Load("gb.desktop") + 'Dim hGrid As GridView + $hView.Background = Color.Background + $hView.Header = GridView.None + '$hView.Font.Grade = 1 + 'hGrid = $hView.Children[0] + 'hGrid.Rows.Height = 50 + $hView.Add("Places", "Places") + $hView.Add("Devices", "Devices") + $hView["Places"].Expanded = True + $hView["Places"].Font = Font["Bold"] + $hView["Devices"].Expanded = True + $hView["Devices"].Font = $hView["Places"].Font + For Each hb In $hBookmarks + $hView.Add(hb.Path, hb.Name, Picture[Replace(hb.Icon, "small", "22")], "Places") + Next + + LoadDrives() + + +End + +Private Sub LoadDrives() + + Dim s As String + Dim hDisk As _Block + $hView["Devices"].Clear + + For Each s In Disks.GetList() + 'Print s + 'print Disks[s].Device + 'Print Disks[s].Drive.Optical + hDisk = Disks[s] + If Not hDisk.CanMount Then Continue + If Not hDisk.Drive.Removable Then Continue + If hDisk.IsMounted And If $hBookmarks.FindBookmark(hDisk.MountPoints[0]) <> Null Then Continue + + $hView.Add(s, hDisk.IdLabel, Picture["icon:/22" &/ hDisk.Icon], "Devices") + + Next + +End + +Private Sub IsInBookmark(sValue As String) As Boolean + + $hBookmarks.FindBookmark + +End + +Public Sub Free() + + Disks.Free + +End + + + diff --git a/comp/src/gb.form/.src/File/Disks/Disks.class b/comp/src/gb.form/.src/File/Disks/Disks.class new file mode 100644 index 000000000..25deaf3c3 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/Disks.class @@ -0,0 +1,172 @@ +' Gambas class file + +Create Static +Class DBusSignal +Class DBusConnection +Class DBus +Private Const $sBus As String = "system://" +Private Const $sApplication As String = "org.freedesktop.UDisks2" +Private $sRootDbusPath As String = "/org/freedesktop/UDisks2/block_devices" +Private Const $sBaseInterface As String = "org.freedesktop.UDisks2." + +Private $aListBlock As String[] +Private $cBlock As New Collection +Private $hSignal As DBusSignal +Private $hDBusConnection As DBusConnection + +Static Public _USEDBUS As Boolean + +Event DeviceAdded(Block As String) +Event DeviceRemoved(Block As String) +Event DeviceMounted(Block As String) +Event DeviceUnMounted(Block As String) +Private $cJobs As New Collection + +Static Public Sub _init() + + Component.Load("gb.dbus") + +End + +Public Sub _new() + + Disks._USEDBUS = Component.IsLoaded("gb.dbus") + + If Env["GB_DISKS_NODBUS"] = 1 Then Disks._USEDBUS = False + + If Disks._USEDBUS Then + Try $hDBusConnection = DBus[$sBus & $sApplication].Connection + $hSignal = New DBusSignal($hDBusConnection, "org.freedesktop.DBus.ObjectManager", True) As "Signal" + Endif + +End + +Public Sub _next() As String + + Dim s As String + + If Not $aListBlock Then $aListBlock = GetList() 'GetPathChildsDBus($sRootDbusPath) + + If IsNull(Enum.Index) Then + Enum.Index = 0 + Else + Inc Enum.Index + Endif + If Enum.Index >= $aListBlock.Count Then + Enum.Stop + $aListBlock = Null + Return + Endif + + s = $aListBlock[Enum.Index] + Return s + +End + +' Private Function GetPathChildsDBus(sPath As String) As String[] +' +' Dim s As String +' Dim aList As New String[] +' +' For Each s In DBus[$sBus & $sApplication][sPath].Children +' If Not DBus[$sBus & $sApplication][$sRootDbusPath].Children.Exist(s) Then Continue 'dblcheck +' aList.Add(s) +' Next +' +' Return aList.Sort(gb.Natural) +' +' End + +Public Sub _get(Block As String) As _Block + + Dim hBlock As _Block + + If Not $cBlock.Exist(Block) Then + If Disks._USEDBUS Then + hBlock = New _BlockDBus(Block) As "Block" + Else + hBlock = New _BlockNoDBus(Block) As "Block" + Endif + 'If Error Then Return Null + $cBlock[Block] = hBlock + Endif + Return $cBlock[Block] + +End + +Public Sub Free() + + If Disks._USEDBUS Then + $hSignal.Enabled = False + $hSignal = Null + Endif + +End + +Public Sub Signal_Signal(Signal As String, Arguments As Variant[]) + + Print Signal + Print Arguments[0] + + 'If InStr(Arguments[0], "jobs") Then Stop + If Signal = "InterfacesRemoved" Then + If InStr(Arguments[0], "block_devices") Then + Raise DeviceRemoved(File.name(Arguments[0])) + Return + + Endif + If InStr(Arguments[0], "jobs") Then + If $cJobs.Exist(Arguments[0]) Then + Select Case $cJobs[Arguments[0]]["org.freedesktop.UDisks2.Job"]["Operation"] + Case "filesystem-mount" + Raise DeviceMounted(File.name($cJobs[Arguments[0]]["org.freedesktop.UDisks2.Job"]["Objects"][0])) + Case "filesystem-unmount" + Raise DeviceUnMounted(File.name($cJobs[Arguments[0]]["org.freedesktop.UDisks2.Job"]["Objects"][0])) + End Select + + $cJobs.Remove(Arguments[0]) + Endif + 'Stop + Endif + + Endif + + If Signal = "InterfacesAdded" Then + If InStr(Arguments[0], "block_devices") Then + Raise DeviceAdded(File.name(Arguments[0])) + Endif + Endif + + If Signal = "InterfacesAdded" Then + If InStr(Arguments[0], "jobs") Then 'And If Arguments[1]["org.freedesktop.UDisks2.Job"]["Operation"] = "filesystem-mount" Then + $cJobs[Arguments[0]] = Arguments[1] + 'sDeviceMount = + Endif + Endif + +End + +Public Sub GetList() As String[] + + Dim aRet As New String[] + If Disks._USEDBUS Then + + Return DBus[$sBus & $sApplication][$sRootDbusPath]._GetSymbols("node") + Else + Return aRet + 'Return GetDrives("/sys/block") + Endif + +End + +Private Sub GetDrives(sPath As String) As String[] + Dim aRet As New String[] + Dim aSub As String[] + Dim s As String + For Each s In Dir(sPath, File.BaseName(sPath) & "*", gb.Directory) + aRet.Add(s) + aSub = GetDrives(sPath &/ s) + aRet.Insert(aSub) + Next + Return aRet +End diff --git a/comp/src/gb.form/.src/File/Disks/Drives.class b/comp/src/gb.form/.src/File/Disks/Drives.class new file mode 100644 index 000000000..2ed914f73 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/Drives.class @@ -0,0 +1,92 @@ +' Gambas class file + +Create Static +Class DBus +Private Const $sBus As String = "system://" +Private Const $sApplication As String = "org.freedesktop.UDisks2" +Private $sRootDbusPath As String = "/org/freedesktop/UDisks2/drives" +Private Const $sBaseInterface As String = "org.freedesktop.UDisks2." + +Private $aListDrive As String[] +Private $cDrive As New Collection +Private $bDBus As Boolean + +Static Public Sub _init() + + Component.Load("gb.dbus") + +End + +Public Sub _new() + + Disks._USEDBUS = Component.IsLoaded("gb.dbus") + If Env["GB_DISKS_NODBUS"] = 1 Then Disks._USEDBUS = False + +End + +Public Sub _next() As String + + Dim s As String + + If Not $aListDrive Then $aListDrive = GetList() + + If IsNull(Enum.Index) Then + Enum.Index = 0 + Else + Inc Enum.Index + Endif + If Enum.Index >= $aListDrive.Count Then + Enum.Stop + $aListDrive = Null + Return + Endif + + s = $aListDrive[Enum.Index] + Return s + +End + +Public Sub _get(Drive As String) As _Drive + + Dim hDrive As _Drive + + If Not $cDrive.Exist(Drive) Then + If Disks._USEDBUS Then + hDrive = New _DriveDBus(Drive) As "Drive" + Else + hDrive = New _DriveNoDBus(Drive) As "Drive" + Endif + 'If Error Then Return Null + $cDrive[Drive] = hDrive + Endif + Return $cDrive[Drive] + +End + +Public Sub GetList() As String[] + + Dim aRet As New String[] + If $bDBus Then + Return DBus[$sBus & $sApplication][$sRootDbusPath]._GetSymbols("node") + Else + + 'Return GetDrives("/sys/block") + + Endif + +End + +Private Sub GetDrives(sPath As String) As String[] + Dim aRet As New String[] + Dim aSub As String[] + Dim s As String + For Each s In Dir(sPath, File.BaseName(sPath) & "*", gb.Directory) + aRet.Add(s) + aSub = GetDrives(sPath &/ s) + aRet.Insert(aSub) + Next + Return aRet +End + + + diff --git a/comp/src/gb.form/.src/File/Disks/FTestDisk.class b/comp/src/gb.form/.src/File/Disks/FTestDisk.class new file mode 100644 index 000000000..1a7237b51 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/FTestDisk.class @@ -0,0 +1,34 @@ +' Gambas class file + + +Public Sub _new() + + FileView1.Dir = User.Home + +End + +Public Sub Form_Close() + + DiskPanel1.Free + +End + +Public Sub FileView1_Activate() + + FileView1.Dir = FileView1.Dir &/ FileView1.Current + +End + +Public Sub FileView1_Icon(Path As String) + Dim hImage As Image + hImage = thumbnailer.GetThumbnail(Path) + + FileView1.Icon = hImage.Picture + +End + +Public Sub Form_Open() + + + +End diff --git a/comp/src/gb.form/.src/File/Disks/FTestDisk.form b/comp/src/gb.form/.src/File/Disks/FTestDisk.form new file mode 100644 index 000000000..36b7cbc20 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/FTestDisk.form @@ -0,0 +1,52 @@ +# Gambas Form File 3.0 + +{ Form Form + MoveScaled(0,0,105,62) + Text = ("Simple File Navigator") + Arrangement = Arrange.Vertical + { HBox2 HBox + MoveScaled(0,0,103,5) + { ToolButton1 ToolButton + MoveScaled(1,0,5,4) + Picture = Picture["icon:/22/up"] + } + { Spring1 Spring + MoveScaled(38,2,10,2) + } + { Panel1 Panel + MoveScaled(88,0,10.8571,5.8571) + Arrangement = Arrange.Horizontal + { ToolButton2 ToolButton Views + Name = "ToolButton2" + MoveScaled(0,1,5,4) + Picture = Picture["icon:/22/view-detail"] + Radio = True + Toggle = True + } + { ToolButton3 ToolButton Views + Name = "ToolButton3" + MoveScaled(5,0,5,5) + Picture = Picture["icon:/22/view-icon"] + Radio = True + Toggle = True + Value = True + } + } + } + { DirBrowser1 DirBrowser + MoveScaled(1,6,97,4) + } + { HBox1 HBox + MoveScaled(1,13,106,57) + Expand = True + { DiskPanel1 DiskPanel + MoveScaled(2,8,34,46) + } + { FileView1 FileView + MoveScaled(40,0,66,61) + Expand = True + ShowDirectory = True + ShowPreview = True + } + } +} diff --git a/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.class b/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.class new file mode 100644 index 000000000..f1c33c727 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.class @@ -0,0 +1,8 @@ +' Gambas class file + + +Public Sub Form_Open() + + Me.Picture = Thumbnailer["/home/fabien/Images/19578541_10211281747630910_625519452_o.jpg"] + +End diff --git a/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.form b/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.form new file mode 100644 index 000000000..4b2af5573 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/FTestThumbnailer.form @@ -0,0 +1,5 @@ +# Gambas Form File 3.0 + +{ FTestThumbnailer Form + MoveScaled(0,0,64,64) +} diff --git a/comp/src/gb.form/.src/File/Disks/MTestDisk.module b/comp/src/gb.form/.src/File/Disks/MTestDisk.module new file mode 100644 index 000000000..f0c87e22a --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/MTestDisk.module @@ -0,0 +1,7 @@ +' Gambas module file + +Public Sub Main() + + Print Disks.GetList().Join("\n") + Disks.Free +End diff --git a/comp/src/gb.form/.src/File/Disks/_Block.class b/comp/src/gb.form/.src/File/Disks/_Block.class new file mode 100644 index 000000000..e1a49f0e2 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_Block.class @@ -0,0 +1,91 @@ +' Gambas class file + +Property Read Device As String +Property Read Drive As _Drive +Property Read ReadOnly As Boolean +Property Read FileSystem As String +Property Read MountPoints As String[] +Property Read CanMount As Boolean +Property Read IsMounted As Boolean +Property Read Icon As String +Property Read IdType As String +Property Read IdLabel As String +Property Read IdUUID As String +Property Read IdUsage As String + +Public Sub _new() + +End + +Private Function Device_Read() As String + +End + +Private Function Drive_Read() As _Drive + +End + +Private Function ReadOnly_Read() As Boolean + +End + +Private Function FileSystem_Read() As String + +End + +Private Function MountPoints_Read() As String[] + +End + +Private Function CanMount_Read() As Boolean + +End + +Private Function IsMounted_Read() As Boolean + +End + + + +Private Function Icon_Read() As String + +' If InStr(Me.Device, "sr") Then Stop + If Not Me.CanMount Then Return + If Me.Drive.Optical Then + Return "cdrom" + Else + Select Case Me.Drive.ConnectionBus + Case "usb" + Return "usb" + Case "cpio" + Return "sdcard" + Case Else + Return "harddisk" + End Select + Endif + +End + +Private Function IdType_Read() As String + + + +End + +Private Function IdLabel_Read() As String + + + +End + +Private Function IdUUID_Read() As String + + + +End + +Private Function IdUsage_Read() As String + + + +End diff --git a/comp/src/gb.form/.src/File/Disks/_BlockDBus.class b/comp/src/gb.form/.src/File/Disks/_BlockDBus.class new file mode 100644 index 000000000..1327a4064 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_BlockDBus.class @@ -0,0 +1,138 @@ +' Gambas class file + +Inherits _Block + +Class DBus + +Private $sDrv As String + +Static Private Const $sBus As String = "system://" +Static Private Const $sApplication As String = "org.freedesktop.UDisks2" +Static Private Const $sRootDbusPath As String = "/org/freedesktop/UDisks2/block_devices" +Static Private Const $sBaseInterface As String = "org.freedesktop.UDisks2." + +Private $sMyPath As String + +Property Read Device As String +Property Read Drive As _Drive +Property Read ReadOnly As Boolean +Property Read FileSystem As String +Property Read MountPoints As String[] +Property Read CanMount As Boolean +Property Read IsMounted As Boolean +Property Read IdType As String +Property Read IdLabel As String +Property Read IdUUID As String +Property Read IdUsage As String + +Public Sub _new(sDrv As String) + + If Not DBus[$sBus & $sApplication][$sRootDbusPath].Children.Exist(sDrv) Then + + Error.Raise("Unknown block device") + Return + + Endif + + $sDrv = sDrv + $sMyPath = $sRootDbusPath &/ sDrv + +End + +Private Function Device_Read() As String + + Dim aBytes As Byte[] + + aBytes = Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].Device + + Return aBytes.ToString() + +End + +Private Function Drive_Read() As _Drive + + Dim sDrive As String = Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].Drive + + If Component.IsLoaded("gb.dbus") Then + Return New _DriveDBus(File.Name(sDrive)) + Else + Return New _DriveNoDBus(File.Name(sDrive)) + Endif + +End + +Private Function ReadOnly_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].ReadOnly + +End + +Private Function FileSystem_Read() As String + + Try Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].IdType + +End + +Private Function MountPoints_Read() As String[] + + Dim aMountPoints As New String[] + Dim aMp As Byte[] + Dim aMps As Byte[][] + 'If InStr(Me.Device, "sda3") Then Stop + If Me.FileSystem Then + Try aMps = Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Filesystem"].MountPoints + + If Not aMps Then Return aMountPoints + + For Each aMP In Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Filesystem"].MountPoints + aMountPoints.Add(aMp.ToString()) + Next + 'Catch + Endif + Return aMountPoints + +End + +Private Function CanMount_Read() As Boolean + + Dim i As Integer + + Try i = Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Filesystem"].Children.Count + + If Not Error Then + Return True + Else + Return False + Endif + +End + +Private Function IsMounted_Read() As Boolean + + Return Me.MountPoints.Count > 0 + +End + +Private Function IdType_Read() As String + + Try Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].IdType + +End + +Private Function IdLabel_Read() As String + + Try Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].IdLabel + +End + +Private Function IdUUID_Read() As String + + Try Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].IdUUID + +End + +Private Function IdUsage_Read() As String + + Try Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Block"].IdUsage + +End \ No newline at end of file diff --git a/comp/src/gb.form/.src/File/Disks/_BlockNoDBus.class b/comp/src/gb.form/.src/File/Disks/_BlockNoDBus.class new file mode 100644 index 000000000..dc1396b05 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_BlockNoDBus.class @@ -0,0 +1,5 @@ +' Gambas class file + +' ' Gambas class file +' +Inherits _Block diff --git a/comp/src/gb.form/.src/File/Disks/_Drive.class b/comp/src/gb.form/.src/File/Disks/_Drive.class new file mode 100644 index 000000000..a44c67480 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_Drive.class @@ -0,0 +1,58 @@ +' Gambas class file + +Property Read CanPowerOff As Boolean +Property Read Ejectable As Boolean +Property Read MediaAvailable As Boolean +Property Read MediaChangeDetected As Boolean +Property Read MediaRemovable As Boolean +Property Read Optical As Boolean +Property Read OpticalBlank As Boolean +Property Read Removable As Boolean +Property Read ConnectionBus As String +Property Read Size As Long +Property Read Id As String + + +Private Function CanPowerOff_Read() As Boolean + +End + +Private Function Ejectable_Read() As Boolean + +End + +Private Function MediaAvailable_Read() As Boolean + +End + +Private Function MediaChangeDetected_Read() As Boolean + +End + +Private Function MediaRemovable_Read() As Boolean + +End + +Private Function Optical_Read() As Boolean + +End + +Private Function OpticalBlank_Read() As Boolean + +End + +Private Function Removable_Read() As Boolean + +End + +Private Function ConnectionBus_Read() As String + +End + +Private Function Size_Read() As Long + +End + +Private Function Id_Read() As String + +End diff --git a/comp/src/gb.form/.src/File/Disks/_DriveDBus.class b/comp/src/gb.form/.src/File/Disks/_DriveDBus.class new file mode 100644 index 000000000..650830db2 --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_DriveDBus.class @@ -0,0 +1,107 @@ +' Gambas class file + +Inherits _Drive + +Class DBus + +Static Private Const $sBus As String = "system://" +Static Private Const $sApplication As String = "org.freedesktop.UDisks2" +Static Private Const $sRootDbusPath As String = "/org/freedesktop/UDisks2/drives" +Static Private Const $sBaseInterface As String = "org.freedesktop.UDisks2." + +Private $sMyPath As String + +Property Read CanPowerOff As Boolean +Property Read Ejectable As Boolean +Property Read MediaAvailable As Boolean +Property Read MediaChangeDetected As Boolean +Property Read MediaRemovable As Boolean +Property Read Optical As Boolean +Property Read OpticalBlank As Boolean +Property Read Removable As Boolean +Property Read ConnectionBus As String +Property Read Size As Long +Property Read Id As String +Private $sDrv As String + + +Public Sub _new(sDrv As String) + + + If Not DBus[$sBus & $sApplication][$sRootDbusPath].Children.Exist(sDrv) Then + + Error.Raise("Unknown Drive device") + Return + + Endif + + $sDrv = sDrv + $sMyPath = $sRootDbusPath &/ sDrv +End + +Private Function CanPowerOff_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].CanPowerOff + +End + +Private Function Ejectable_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].Ejectable + +End + +Private Function MediaAvailable_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].MediaAvailable + +End + +Private Function MediaChangeDetected_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].MediaChangeDetected + +End + +Private Function MediaRemovable_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].MediaRemovable + +End + +Private Function Optical_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].Optical + +End + +Private Function OpticalBlank_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].OpticalBlank + +End + +Private Function Removable_Read() As Boolean + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].Removable + +End + +Private Function ConnectionBus_Read() As String + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].ConnectionBus + +End + +Private Function Size_Read() As Long + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].Size + +End + + +Private Function Id_Read() As String + + Return Dbus[$sBus & $sApplication][$sMyPath, $sBaseInterface & "Drive"].Id + +End diff --git a/comp/src/gb.form/.src/File/Disks/_DriveNoDBus.class b/comp/src/gb.form/.src/File/Disks/_DriveNoDBus.class new file mode 100644 index 000000000..ac048f29f --- /dev/null +++ b/comp/src/gb.form/.src/File/Disks/_DriveNoDBus.class @@ -0,0 +1,83 @@ +' Gambas class file + +' ' Gambas class file + +Inherits _Drive + +' Property Read CanPowerOff As Boolean +' Property Read Ejectable As Boolean +' Property Read MediaAvailable As Boolean +' Property Read MediaChangeDetected As Boolean +' Property Read MediaRemovable As Boolean +' Property Read Optical As Boolean +' Property Read OpticalBlank As Boolean +' Property Read Removable As Boolean +' Property Read ConnectionBus As String +' Property Read Size As Long +' Property Read Id As String +' +' Private $sDrv As String +' Private $sPath As String +' +' Public Sub _new(sDrv As String) +' $sDrv = sDrv +' $sPath = "/sys/block" &/ sDrv +' +' If Not Exist($sPath) Then +' Error.Raise("Unknown Drive device") +' Return +' Endif +' End +' +' Private Function CanPowerOff_Read() As Boolean +' +' End +' +' Private Function Ejectable_Read() As Boolean +' +' End +' +' Private Function MediaAvailable_Read() As Boolean +' +' End +' +' Private Function MediaChangeDetected_Read() As Boolean +' +' End +' +' Private Function MediaRemovable_Read() As Boolean +' +' End +' +' Private Function Optical_Read() As Boolean +' +' End +' +' Private Function OpticalBlank_Read() As Boolean +' +' End +' +' Private Function Removable_Read() As Boolean +' Dim s As String +' s = File.Load($sPath &/ "removable") +' +' If s = "1" Then Return True +' +' End +' +' Private Function ConnectionBus_Read() As String +' +' End +' +' Private Function Size_Read() As Long +' +' Dim l As Long +' +' l = File.Load($sPath &/ "size") +' Return l +' +' End +' +' Private Function Id_Read() As String +' +' End diff --git a/comp/src/gb.form/.src/File/Thumbnailer/Thumbnailer.class b/comp/src/gb.form/.src/File/Thumbnailer/Thumbnailer.class new file mode 100644 index 000000000..ebaba14b8 --- /dev/null +++ b/comp/src/gb.form/.src/File/Thumbnailer/Thumbnailer.class @@ -0,0 +1,355 @@ +' Gambas class file + +Create Static + +Class Hash +Class Date +Class Shell +Class DesktopMime + +'Const THUMBSPATH As String = ".cache/thumbnails" +Const THUMBNAILERSPATH As String = "/usr/share/thumbnailers" +Private $sFullThumbPath As String +'Private $sThumbnailersPath As String +Private $cSizeToDirName As New Collection +Private $cMimeToThumbnailer As New Collection + +Public Struct Thumbnailer + TryExec As String + {Exec} As String +End Struct + +Public Struct Chunk + Size As Integer + Type As String + Crc As String + Datas As String +End Struct + +Public Sub _new() + + Component.Load("gb.hash") + Component.Load("gb.util") + Component.Load("gb.Desktop") + + 'Generate the thumbnails cache directory if not exist + $sFullThumbPath = Desktop.CacheDir &/ "thumbnails" + If Not Exist($sFullThumbPath) Then Main.MkDir($sFullThumbPath) + + '$sThumbnailersPath = + + $cSizeToDirName["128"] = "normal" + $cSizeToDirName["256"] = "large" + $cSizeToDirName["512"] = "x-large" + $cSizeToDirName["1028"] = "xx-large" + + LoadThumbnailers + +End + +Private Sub LoadThumbnailers() + + Dim s As String + Dim sFile As String + Dim sLine As String + Dim a As String[] + Dim hThumbnailer As Thumbnailer + Dim ss As String + + For Each s In Dir(THUMBNAILERSPATH, "*.thumbnailer", gb.File) + sFile = File.Load(THUMBNAILERSPATH &/ s) + hThumbnailer = New Thumbnailer + For Each sLine In Split(sFile, "\n") + If InStr(sLine, "=") Then + Try a = Scan(sLine, "*=*") + If Error Then Break + Select Case LCase(Trim(a[0])) + Case "tryexec" + hThumbnailer.TryExec = Trim(a[1]) + Case "exec" + hThumbnailer.Exec = Trim(a[1]) + Case "mimetype" + For Each ss In Split(a[1], ";") + If ss = "" Then Continue + $cMimeToThumbnailer[ss] = hThumbnailer + Next + End Select + Endif + Next + Next + +End + +Public Sub GetThumbnail(Path As String, Optional Size As Integer = 256) As Image + + Dim sThumbName As String = LCase(Hash.Md5(MakeURI(Path))) & ".png" + Dim hImg As Image + Dim iGoodSize As Integer = GetGoodSize(Size) + Dim sDir As String = $sFullThumbPath &/ $cSizeToDirName[iGoodSize] &/ sThumbName + Dim cInfo As Collection + + If Exist(sdir) Then + cInfo = GetInfoFromPng(sdir) + 'Verify if the thumbnail is uptodate + If Date.ToUnixTime(Stat(Path).LastModified) <> CLong(cInfo["Thumb::MTime"]) Then MakeThumbNail(Path, Size) + Try hImg = Image.Load(sdir) + Else + MakeThumbNail(Path, Size) + Try hImg = Image.Load(sdir) + Endif + Return himg + +End + +Private Sub MakeThumbNail(Path As String, Optional Size As Integer) As Image + + Dim iGoodSize As Integer + + Dim sThumbName As String + Dim sdir As String + Dim sMime As String + Dim sExec As String + Dim dmTime As Date + Dim cInfo As New Collection + Dim sFailDir As String = $sFullThumbPath &/ "fail/gambas-thumbnail-factory" + Dim hImg As Image + + sThumbName = GetThumbnailName(Path) + + 'Check if the Thumbnail generation have already fail + If Exist(sFailDir &/ sThumbName) Then + cInfo = GetInfoFromPng(sFailDir &/ sThumbName) + 'Verify if the thumbnail is uptodate + If Date.ToUnixTime(Stat(Path).LastModified) = CLong(cInfo["Thumb::MTime"]) Then Return + 'else retry + cInfo.Clear + Try Kill sFailDir &/ sThumbName + Endif + + 'Define the Thumb directory + iGoodSize = GetGoodSize(Size) + sDir = $sFullThumbPath &/ $cSizeToDirName[iGoodSize] + If Not Exist(sDir) Then + Main.MkDir(sDir) + Endif + + 'Generate the preview file + + '->Call script depend of mimetype + sMime = DesktopMime.FromFile(Path).Type + If $cMimeToThumbnailer.Exist(sMime) Then + 'Debug "Make thumbnail with : " & $cMimeToThumbnailer[sMime].Exec + sExec = Replace($cMimeToThumbnailer[sMime].Exec, "%s", Str(iGoodSize)) + sExec = Replace(sExec, "%u", "'" & Path & "'") + sExec = Replace(sExec, "%i", "'" & Path & "'") + sExec = Replace(sExec, "%o", "'" & sDir &/ sThumbName & "'") + 'Debug "Shell command : " & sExec + Shell sExec Wait + Else + Return + Endif + +'Fail management +If Not Exist(sDir &/ sThumbName) Then + If Not Exist(sFailDir) Then Shell.MkDir(sFailDir) + hImg = New Image(1, 1, Color.Black) + hImg.Save(sFailDir &/ sThumbName) + sDir = sFailDir +Endif + + + dmTime = Stat(Path).LastModified + 'Set the png chunks + + cInfo["Thumb::URI"] = MakeURI(Path) + cInfo["Thumb::MTime"] = Date.ToUnixTime(dmTime) + cInfo["Software"] = "GAMBAS::ThumbnailFactory" + + SaveInfoToPng(sDir &/ sThumbName, cInfo) + +End + +Private Sub GetThumbnailName(Path As String) As String + + Dim sPathName As String + + Path = MakeURI(Path) + sPathName = LCase(Hash.Md5(Path)) & ".png" + + Return sPathName + +End + +Private Sub GetGoodSize(Size As Integer) As Integer + + Dim i As Integer + + For Each i In [128, 256, 512, 1028] + If size <= i Then Return i + Next + +End + +Private Sub MakeURI((Path) As String) As String + + ''This Function quote the file URI + Dim iInd As Integer + Dim sRes As String + Dim sCar As String + + For iInd = 1 To Len(Path) + sCar = Mid$(Path, iInd, 1) + If IsLetter(sCar) Or If IsDigit(sCar) Or If InStr("-._~,$!/", sCar) Then + Else + sCar = "%" & Hex$(Asc(sCar), 2) + Endif + sRes &= sCar + Next + + 'Add the protocol + sRes = "file://" & sRes + + Return sRes + +End + +Private Sub GetUri((Path) As String, Optional DoNotDecodePlus As Boolean) As String + + Dim iInd As Integer + Dim sRes As String + Dim sCar As String + + For iInd = 1 To Len(Path) + sCar = Mid$(Path, iInd, 1) + If sCar = "%" Then + sCar = Chr$(Val("&H" & Mid$(Path, iInd + 1, 2))) + iInd += 2 + Else If sCar = "+" And If Not DoNotDecodePlus Then + sCar = " " + Endif + sRes &= sCar + Next + + If sRes Begins "file://" Then + sRes = Right(sRes, -7) + Endif + + Return sRes + +End + +Private Sub GetInfoFromPng(Path As String) As Collection + + Dim hFile As File + Dim iSize As Integer + Dim sType As String + Dim hCol As New Collection + Dim sData As String + Dim a As String[] + + hFile = Open Path For Read + hFile.ByteOrder = gb.BigEndian + 'move after magic + Seek #hfile, 8 + Do + iSize = Read #hFile As Integer + sType = Read #hFile, 4 + If sType = "tEXt" Then + sData = Read #hFile, iSize + a = Split(sData, Chr(0)) + hCol[a[0]] = a[1] + Seek #hFile, Seek(hFile) + 4 + Else + Seek #hfile, Seek(hFile) + iSize + 4 + Endif + If sType = "IEND" And iSize = 0 Then Break + Loop + hfile.Close + Return hCol + +End + +Private Sub SaveInfoToPng(Path As String, cInfo As Collection) + + Dim hFile As File + Dim aChunks As New Chunk[] + Dim hChunk As Chunk + Dim i As Integer + Dim s As String + Dim isPng As Byte[] = [137, 80, 78, 71, 13, 10, 26, 10] + Dim sMagic As String + + hFile = Open Path For Read + hfile.ByteOrder = gb.BigEndian + + 'Load the full datas + sMagic = Read #hfile, 8 + + If sMagic <> isPng.ToString() Then + Error.Raise("This file is not a valid png file") + hfile.Close + Return + Endif + + Do + hChunk = New Chunk + hChunk.Size = Read #hFile As Integer + hChunk.Type = Read #hFile, 4 + hChunk.Datas = Read #hFile, hChunk.Size + hChunk.Crc = Read #hFile, 4 + 'forgot the existing tEXt chunks + If hChunk.Type <> "tEXt" Then aChunks.Add(hChunk) + If hChunk.Type = "IEND" And hChunk.Size = 0 Then Break + Loop + + hfile.Close + + 'Adding the collection entries in the chunks array just before the iDAT chunk + For i = 0 To aChunks.Max + If aChunks[i].Type = "IDAT" Then Break + Next + + For Each s In cInfo + s = cInfo.Key & Chr(0) & s + hChunk = New Chunk + hChunk.Type = "tEXt" + hChunk.Size = s.Len + hChunk.Datas = s + hChunk.Crc = String(4, Chr(0)) + aChunks.Add(hChunk, i) + Inc i + Next + + 'Saving the new file + + hFile = Open Path For Write Create + hFile.ByteOrder = gb.BigEndian + + 'Writing the file + Write #hFile, sMagic + + For Each hChunk In aChunks + Write #hFile, hChunk.Size As Integer + Write #hFile, hChunk.Type + Write #hFile, hChunk.Datas + Write #hFile, hChunk.Crc + Next + + hFile.Close + +End + +Public Sub RemoveThumbnail(Path As String) + + Dim sThumbName As String = LCase(Hash.Md5(MakeURI(Path))) & ".png" + Dim s As String + Dim sDir As String + + For Each s In $cSizeToDirName + sDir = $sFullThumbPath &/ s &/ sThumbName + If Exist(sDir) Then + Try Kill sdir + Endif + Next + +End