luisgulo/gambas-source-code
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge branch 'master' of https://gitlab.com/gambas/gambas into desktop-runasroot-pkexec

Browse source
This commit is contained in:
Bruce Steers 2021-09-09 13:13:55 +01:00
commit fabaee070b
28 changed files with 492 additions and 193 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
app/src/gambas3/.project
View file

@ -31,7 +31,7 @@ Component=gb.signal
Description="Integrated Development Environment for Gambas"
Authors="Benoît Minisini\nFabien Bodard\nCharlie Reinl\nJosé Luis Redrejo\nRobert Rowe\nTobias Boege"
Arguments=[["-L"],["-t","/home/benoit/gambas/git/master/app/src/gambas3"],["--help"]]
Environment="GB_GUI=gb.qt5\n GTK_DEBUG=interactive\nGB_NO_JIT=1"
Environment="GB_GUI=gb.gtk3\n GTK_DEBUG=interactive\nGB_NO_JIT=1"
TabSize=2
Translate=1
Language=en

4
app/src/gambas3/.src/Editor/Form/FMenu.class
View file

@ -1137,7 +1137,7 @@ Public Sub gvwMenu_Draw(X As Integer, Y As Integer, Width As Integer, Height As
X += D
Width -= D
Paint.Font.Italic = True
Paint.FillRect(X, Y + Height / 2, Paint.TextSize(sText).Width, 1, If(Row = gvwMenu.Row, Color.SelectedBackground, Color.TextBackground))
Paint.FillRect(X, Y + Height / 2, Paint.TextSize(sText).Width, 1, If(Row = gvwMenu.Row, Color.LightBackground, Color.TextBackground))
Else
@ -1183,7 +1183,7 @@ Public Sub gvwMenu_Data(Row As Integer, Column As Integer)
gvwMenu.Data.Foreground = GetMenuColor($aMenu[Row])
If Row = gvwMenu.Row Then gvwMenu.Data.Background = Color.SelectedBackground
If Row = gvwMenu.Row Then gvwMenu.Data.Background = Color.LightBackground
If .Level = 0 Then
gvwMenu.Data.Font.Bold = True

7
app/src/gambas3/.src/FMain.class
View file

@ -95,7 +95,6 @@ Public Sub Form_Open()
'tvwProject_LostFocus
frmWelcome = New FWelcome(dwgWelcome)
frmWelcome.Hide
Project.UseInheritance = Settings["/UseInheritance", True]
btnUseInheritance.Value = Project.UseInheritance
@ -104,10 +103,10 @@ Public Sub Form_Open()
End
Public Sub Welcome()
Public Sub HideWelcome()
frmWelcome.Show
dwgWelcome.Refresh
frmWelcome.Hide
'dwgWelcome.Refresh
End

1
app/src/gambas3/.src/FMain.form
View file

@ -1397,6 +1397,7 @@
}
{ panProperty SidePanel
MoveScaled(97,1,32,65)
Visible = False
ToolTip = ("Properties")
Arrangement = Arrange.Vertical
Action = "property"

22
app/src/gambas3/.src/Family/Report/CoordBox.class
View file

@ -170,25 +170,35 @@ End
Private Sub Border_Write(Value As Boolean)
$bBorder = Value
$hBackground.Padding = If(Value, Style.TextBoxFrameWidth, 0)
$hBackground.Padding = If(Value, Style.FrameWidth, 0)
Me.Refresh
End
Public Sub Background_Draw()
Dim iBg As Integer = Color.TextBackground
Dim iCol As Integer
Dim iState As Integer
If Me.Background <> Color.Default Then iBg = Me.Background
iCol = Style.BackgroundOf($hTextBox)
If $bBorder Then
Style.PaintBox(0, 0, Me.W, Me.H, Style.StateOf($hTextBox), iBg)
If $bBorder Then
iState = Style.StateOf($hBackground)
If $hTextBox.HasFocus Then iState = iState Or Style.HasFocus
If $hBackground.Hovered Then iState = iState Or Style.Hovered
Style.PaintBox(0, 0, Paint.W, Paint.H, iState, iCol)
Else
Paint.FillRect(0, 0, Me.W, Me.H, iBg)
Paint.FillRect(0, 0, Paint.W, Paint.H, iCol)
Endif
End
Private Function Editor_Read() As MaskBox
Return $hTextBox

8
app/src/gambas3/.src/Project.module
View file

@ -426,7 +426,9 @@ Public Sub Main()
FMain.Show
If sPath Then
If File.IsRelative(sPath) Then sPath = Application.Dir &/ sPath
If IsDir(sPath) Then
Project.Open(sPath)
For Each sPath In aOpenFile
@ -437,17 +439,19 @@ Public Sub Main()
Else
FMain.ShowWarning(("File not found!") & "\n\n<tt>" & sPath & "</tt>")
Endif
If Not Project.Dir Then
FMain.Close
Dec Application.Busy
Return
Endif
FMain.HideWelcome
Endif
RefreshActivate
If Not sPath Then FMain.Welcome
Dec Application.Busy
If Settings["/ShowTipOnStartup", True] Then

6
app/src/gbs3/.hidden/CHANGELOG
View file

@ -1,3 +1,9 @@
* Sun Aug 08 2021 benoit <benoit@localhost> 3.16.90
* Sun Aug 08 2021 benoit <benoit@localhost> 3.16.90
* Sun Aug 08 2021 benoit <benoit@localhost> 3.16.90
* Tue Apr 20 2021 benoit <benoit@localhost> 3.15.90
* Thu Mar 18 2021 benoit <benoit@localhost> 3.15.90

6
app/src/gbs3/.project
View file

@ -8,8 +8,8 @@ Component=gb.eval
Component=gb.pcre
Description="Gambas Script"
Authors="Fabien Bodard, Benoit Minisini, Brian G"
Arguments=[["--help"],["--use","'gb.notify,gb.web'","-e","For i as Integer = 0 To 10:Print \"Hello World\":Next"],["~/bin/who"],["-c","-T","~/bin/mytest"],["-v","TestApp"],["--verbose","TestAppWithMain"],["--verbose","TestLazyApp"],["-c","~/testerror.gbs"],["~/Scripts/TestQuoteAtEnd"],["-c","~/Scripts/AForm"],["-c","-v","-w","~/Scripts/GambasHelpSearch"],["-c","-v","-w","~/Scripts/AMain"],["-c","-v","-w","~/Scripts/gshoutput"],["-c","-v","-w","~/Scripts/TestSets/TestWebApp.gbs"],["--convert-project","~/Projects/TestPrograms/testerror"],["--convert-project","~/Projects/TestPrograms/testusingtxthighlight","~/Scripts/TestSets"],["-c","-v","~/Scripts/TestSets/testusingtxthighlight.gbs"],["-l","library"],["-c","-v","-w","~/Scripts/TestScripterNoMain"],["-c","-v","-w","~/Scripts/TestGUI.gbs"],["-c","-v","-w","~/Scripts/TestSets/CPU_Test.gbs"],["-c","-v","-w","~/Scripts/TestSets/TestWebPage.gbs"],["-c","-v","-w","--convert-script","~/Scripts/TestSets/CPU_Test.gbs","~/Scripts"],["-c","-v","-w","~/Scripts/CPU_Test"],["-c","-v","-w","-p","~/Scripts/TestPlugin","~/myplugins"],["-c","-v","-w","~/Scripts/RunComponent"],["-c","-v","-w","~/Scripts/TestTestAppIncludes"],["-v","~/Projects/TestTimer"],["-c","-v","-w","~/gbs3testwithclass.gbs"],["-c","-v","-w","/home/brian/Scripts/testLocalStatic.gbs"],["-c","-v","-w","TestExternStructNoMain.gbs"],["-c","-v","-w","TestExternStructWithMain.gbs"]]
CurrentArgumentList=["-c","-v","-w","~/Scripts/TestTestAppIncludes"]
Arguments=[["--help"],["--use","'gb.notify,gb.web'","-e","For i as Integer = 0 To 10:Print \"Hello World\":Next"],["~/bin/who"],["-c","-T","~/bin/mytest"],["-v","TestApp"],["--verbose","TestAppWithMain"],["--verbose","TestLazyApp"],["-c","~/testerror.gbs"],["~/Scripts/TestQuoteAtEnd"],["-c","~/Scripts/AForm"],["-c","-v","-w","~/Scripts/GambasHelpSearch"],["-c","-v","-w","~/Scripts/AMain"],["-c","-v","-w","~/Scripts/gshoutput"],["-c","-v","-w","~/Scripts/TestSets/TestWebApp.gbs"],["--convert-project","~/Projects/TestPrograms/testerror"],["-v","--convert-project","~/Projects/TestPrograms/testusingtxthighlight","~/Scripts/TestSets2"],["-c","-v","~/Scripts/TestSets/testusingtxthighlight.gbs"],["-l","library"],["-c","-v","-w","~/Scripts/TestScripterNoMain"],["-c","-v","-w","~/Scripts/TestGUI.gbs"],["-c","-v","-w","~/Scripts/TestSets/CPU_Test.gbs"],["-c","-v","-w","~/Scripts/TestSets/TestWebPage.gbs"],["-c","-v","-w","--convert-script","~/Scripts/TestSets/CPU_Test.gbs","~/Scripts"],["-c","-v","-w","~/Scripts/CPU_Test"],["-c","-v","-w","-p","~/Scripts/TestPlugin","~/myplugins"],["-c","-v","-w","~/Scripts/RunComponent"],["-c","-v","-w","~/Scripts/TestTestAppIncludes"],["-v","~/Projects/TestTimer"],["-c","-v","-w","~/gbs3testwithclass.gbs"],["-c","-v","-w","/home/brian/Scripts/testLocalStatic.gbs"],["-c","-v","-w","TestExternStructNoMain.gbs"],["-c","-v","-w","TestExternStructWithMain.gbs"]]
CurrentArgumentList=["-v","--convert-project","~/Projects/TestPrograms/testusingtxthighlight","~/Scripts/TestSets2"]
TabSize=2
Translate=1
Language=en_US
@ -19,7 +19,7 @@ Vendor=Princeton
Address=benoit@localhost
Url=http://gambas.sourceforge.net/en/main.html
License=General Public Licence
PackageName=gbs3-3.15.90
PackageName=gbs3-3.16.90
PackageVersion=10
CreateEachDirectory=1
Packager=1

11
app/src/gbs3/.src/ConvertProject.module
View file

@ -30,8 +30,8 @@ Public Sub _call(sInputProjectDir As String, Optional sOutputScriptDir As String
Endif
Dim ScriptFile As String = "#!/usr/bin/env gbs3 \n'Auto Generated Script " & CStr(Now) & " Version (" & Application.version & ")\n"
Dim ScriptName As String = Split(sourceProject, "/").last
Dim ScriptName As String = Split(sourceProject, "/", "\"\"", True).last
Verbose("Create Script : " & ScriptName & ".gbs")
If DestPath <> "" Then ' we have the destination directory
If Not Exist(DestPath) Then
@ -42,7 +42,8 @@ Public Sub _call(sInputProjectDir As String, Optional sOutputScriptDir As String
Else
DestPath = Env["PWD"] &/ ScriptName & ".gbs"
Endif
Verbose("Full output path : " & DestPath)
Dim aProjectFile As String[]
Try aProjectFile = Split(File.Load(sourceProject &/ ".project"), "\n", "\"\"", True, True)
If Error Then
@ -75,6 +76,8 @@ Public Sub _call(sInputProjectDir As String, Optional sOutputScriptDir As String
Endif
Next
Verbose("Project Information :\n_____________________________________________\n" & ScriptFile & "____________________________________\n")
For Each sourceDir As String In cSources
sPath = SourceProject &/ sourceDir
If Not Exist(sPath) Then
@ -86,7 +89,7 @@ Public Sub _call(sInputProjectDir As String, Optional sOutputScriptDir As String
Dim Program As String
Try Program = File.Load(sPath &/ s)
If Error Then
Warning("Unable to generate Script using file:" & Error.text & " : " & sPath &/ s, True)
Warning("Unable to generate Script using file:" & Error.text & " : " & sPath &/ s, True)
Return
Endif

1
comp/src/gb.form.editor/.src/CDocument.class
View file

@ -873,6 +873,7 @@ Private Sub HighlightLine(Y As Integer) As Boolean
With Info(PY)
TextHighlighter.State = .State
TextHighlighter.Tag = .Tag
TextHighlighter.Alternate = .Alternate
End With
Endif

2
comp/src/gb.web.gui/.src/Menu/WebMenu.class
View file

@ -44,6 +44,7 @@ Private Sub Image_Write(Value As String)
$sImage = Value
Me.Refresh
If $sImage Then WebForm._AddPreload(Me._GetImageLink($sImage))
End
@ -56,6 +57,7 @@ End
Private Sub Shortcut_Write(Value As String)
If $sShortcut = Value Then Return
Me._RegisterShortcut(Value, $sShortcut)
$sShortcut = Value
Me.Refresh

14
comp/src/gb.web.gui/.src/Message/FMessage.class
View file

@ -14,20 +14,34 @@ End
Public Sub SetButton(sButton1 As String, Optional sButton2 As String, sButton3 As String)
Dim hLast As WebButton
If sButton1 Then
btnButton1.Text = sButton1
btnButton1.Default = True
hLast = btnButton1
Endif
If sButton2 Then
btnButton2.Text = sButton2
btnButton2.Show
hLast = btnButton2
Endif
If sButton3 Then
btnButton3.Text = sButton3
btnButton3.Show
hLast = btnButton3
Endif
If Not hLast Then
btnButton1.Text = ("OK")
btnButton1.Default = True
hLast = btnButton1
Endif
If hLast Then hLast.Cancel = True
End
Public Sub _new()

46
comp/src/gb.web.gui/.src/Table/WebTable.class
View file

@ -3,15 +3,17 @@
Export
Inherits WebControl
Public Const _Properties As String = "*,Border=True,Mode{Select.*}=None,ShowCheck=True,ShowHeader=True,ShowRowNumber,Sortable"
Public Const _Properties As String = "*,Border=True,Mode{Select.*}=None,ShowCheck=True,Header{WebTable.None;Horizontal;Vertical;Both}=Horizontal,ShowRow,Sortable"
Public Const _Group As String = "View"
Public Const _DrawWith As String = "GridView"
Public Const _DefaultSize As String = "24,24"
Public Const _DefaultEvent As String = "Data"
Public Enum None, Horizontal, Vertical, Both
Event Data(Row As Integer, Column As Integer, Data As WebTableData)
Event Select
Event DblClick
Event Activate
Event Sort
Property Read Columns As _WebTableColumns
@ -25,8 +27,8 @@ Property Step As Integer
Property ScrollX As Integer
Property ScrollY As Integer
Property ShowCheck As Boolean
Property Header As Integer
Property ShowHeader As Boolean
Property ShowRowNumber As Boolean
Property Sortable As Boolean
Property SortColumn As Integer
Property SortOrder As Integer
@ -44,12 +46,11 @@ Private $iScrollX As Integer
Private $iScrollY As Integer
Private $bNoScrolling As Boolean
Private $bNoCheck As Boolean
Private $bNoHeader As Boolean
Private $iEnsureVisible As Integer = -1
Private $bSortable As Boolean
Private $iSortColumn As Integer = -1
Private $bSortDescent As Boolean
Private $bShowRowNumber As Boolean
Private $iHeader As Integer = Horizontal
Public Sub _new()
@ -72,8 +73,11 @@ Private Sub PrintRow(iRow As Integer)
Dim hData As WebTableData
Dim sStyle As String
Dim NX As Integer
Dim bNoHeader As Boolean
If $bShowRowNumber Then
bNoHeader = ($iHeader And Horizontal) = 0
If $iHeader And Vertical Then
Print "<td class=\"gw-table-index\">"; iRow + 1; "</td>";
Endif
@ -94,7 +98,7 @@ Private Sub PrintRow(iRow As Integer)
Print "</td>";
Endif
If $bNoHeader Then
If bNoHeader Then
For iCol = 0 To $hColumns.Count - 1
If $hColumns[iCol].Expand Then Inc NX
Next
@ -111,7 +115,7 @@ Private Sub PrintRow(iRow As Integer)
Print "<td";
hCol._PrintAlignment()
sStyle = ""
If $bNoHeader And If iRow = 0 Then
If bNoHeader And If iRow = 0 Then
If hCol.Expand Then
Print " width=\""; 100 \ NX; "%\"";
Else If hCol.Width Then
@ -156,7 +160,7 @@ Private Sub PrintBody(iStart As Integer, iEnd As Integer)
If $iMode <> Select.Single Then Print ",event";
Print ");\"";
Print Me._GetEventJS("ondblclick", "DblClick");
Print Me._GetEventJS("ondblclick", "Activate");
Endif
Print ">";
@ -186,7 +190,7 @@ Public Sub _Render()
Print "<table id=\""; Me.Name; ":table\" width=\"100%\" cellspacing=\"0\" cellpadding=\"0\">"
'Endif
If Not $bNoHeader Then $hColumns._Render()
If $iHeader And Horizontal Then $hColumns._Render()
If $iDisplay < 0 Then
iCount = $iCount
@ -532,13 +536,19 @@ End
Private Function ShowHeader_Read() As Boolean
Return Not $bNoHeader
Return $iHeader <> 0
End
Private Sub ShowHeader_Write(Value As Boolean)
$bNoHeader = Not Value
If Value Then
If $iHeader And Horizontal Then Return
$iHeader += Horizontal
Else
If ($iHeader And Horizontal) = 0 Then Return
$iHeader -= Horizontal
Endif
Me.Refresh
End
@ -615,16 +625,18 @@ Private Sub SortOrder_Write(Value As Integer)
End
Private Function ShowRowNumber_Read() As Boolean
Return $bShowRowNumber
Private Function Header_Read() As Integer
Return $iHeader
End
Private Sub ShowRowNumber_Write(Value As Boolean)
Private Sub Header_Write(Value As Integer)
If $bShowRowNumber = Value Then Return
$bShowRowNumber = Value
Value = Value And 3
If $iHeader = Value Then Return
$iHeader = Value
Me.Refresh
End

6
comp/src/gb.web.gui/.src/Table/_WebTableColumns.class
View file

@ -56,15 +56,15 @@ Public Sub _Render()
Print "<thead><tr>";
If hTable.ShowRowNumber Then Print "<th></th>";
If hTable.Header And WebTable.Vertical Then Print "<th class=\"gw-table-index\"></th>";
iMode = hTable.Mode
If iMode And If hTable.ShowCheck Then
If iMode = Select.Multiple Then
Print "<th class=\"gw-table-check\">";
Print "<input type=\"checkbox\"";
Print GetTable()._GetUpdateJS("onchange", "!!", "this.checked");
If GetTable()._IsEverythingSelected() Then Print " checked";
Print hTable._GetUpdateJS("onchange", "!!", "this.checked");
If hTable._IsEverythingSelected() Then Print " checked";
Print "></th>"
Else
Print "<th></th>"

6
comp/src/gb.web.gui/.src/Test/Webform1.class
View file

@ -256,3 +256,9 @@ Public Sub WebSpinBox1_Change()
lblSpinBox.Text = "-> " & CStr(WebSpinBox1.Value)
End
Public Sub WebMenu17_Click()
Message(Last.Text)
End

3
comp/src/gb.web.gui/.src/Test/Webform1.webform
View file

@ -149,7 +149,7 @@
#MoveScaled(1,15,133.75,40)
Expand = True
Mode = Select.Multiple
ShowRowNumber = True
Header = WebTable.Both
Sortable = True
}
Index = 1
@ -218,7 +218,6 @@
{ WebTree1 WebTree
#MoveScaled(1,1,133.75,49)
Expand = True
ShowCheck = True
ShowHeader = True
}
Index = 0

1
comp/src/gb.web.gui/.src/Test/Webform2.webform
View file

@ -28,6 +28,7 @@
{ WebButton1 WebButton
#MoveScaled(10,1,16,4)
Text = ("Cancel")
Cancel = True
}
{ WebHBox2 WebHBox
#MoveScaled(26,1,7,4)

23
comp/src/gb.web.gui/.src/Test/Webform3.class
View file

@ -1,10 +1,10 @@
' Gambas class file
Export
'Export
Static Public Sub _init()
WebForm.Debug = True
'WebForm.Debug = True
End
'
@ -26,10 +26,15 @@ Public Sub WebForm_KeyPress()
WebTextArea1.Text &= Last.Name & ": " & JSON.ToString(Key._Event) & " " & Key.Shortcut & " '" & Key.Text & "'\n"
End
'
'
' Public Sub WebTextBox1_KeyPress()
'
' WebTextArea1.Text &= Last.Name & ": " & JSON.ToString(Key._Event) & " " & Key.Shortcut & "\n"
'
' End
Public Sub WebTextBox1_KeyPress()
WebTextArea1.Text &= Last.Name & ": " & JSON.ToString(Key._Event) & " " & Key.Shortcut & "\n"
End
Public Sub WebForm_Open()
WebForm.Debug = True
End

50
comp/src/gb.web.gui/.src/Tree/WebTree.class
View file

@ -200,7 +200,6 @@ End
Public Sub Remove((Key) As String)
Dim iRow As Integer
Dim hItem As _WebTreeItem
'If $hRenameBox Then Cancel()
@ -211,17 +210,7 @@ Public Sub Remove((Key) As String)
If Not hItem Then Error.Raise("Unknown item: " & Key)
_SaveSelection
iRow = _ItemToRow(hItem)
RemoveRec(Key)
_AddCount(0)
'If iRow >= 0 Then UpdateRowHeight(Null, iRow, -1)
_RestoreSelection
_RefreshView
End
@ -745,22 +734,23 @@ End
Public Sub SelectAll()
If $iMode <> Select.Multiple Then Return
$hSelection.SelectAll()
If $hSelection.SelectAll() Then Return
Raise Select
Me.Refresh
End
Public Sub UnselectAll()
If $iMode = Select.Multiple Then
$hSelection.UnSelectAll()
If $hSelection.UnSelectAll() Then Return
Raise Select
Else If $iMode = Select.Single Then
If $sKey Then
$sKey = ""
Raise Select
Endif
If Not $sKey Then Return
$sKey = ""
Raise Select
Endif
Me.Refresh
End
@ -1174,9 +1164,10 @@ Private Sub PrintItem(hItem As _WebTreeItem, iLevel As Integer, bVisible As Bool
If $iMode <> Select.Single Then Print ",event";
Print ");\"";
Print Me._GetEventJS("ondblclick", "DblClick");
Endif
Print Me._GetUpdateJS("ondblclick", "%" & JS(sKeyBase64));
If Not bVisible Then Print " style=\"display:none;\"";
Print ">";
@ -1198,17 +1189,17 @@ Private Sub PrintItem(hItem As _WebTreeItem, iLevel As Integer, bVisible As Bool
'Print "<td onmousedown=\"gw.table.check("; JS(Me.Name); ","; CStr(iRow);
'If $iMode <> Select.Single Then Print ",event";
'Print ")\">";
Print "<div class=\"gw-tree-check\">";
'Print "<div class=\"gw-tree-check\">";
If $iMode = Select.Single Then
Print "<input type=\"radio\" name=\""; Me.Name; "\"";
Else
Print "<input type=\"checkbox\"";
Endif
Print " id=\""; Me.Name & ":" & Base64(sKey); "\"";
Print " id=\""; Me.Name & ":" & Base64(sKey); "\" class=\"gw-tree-check\"";
'Print Me._GetUpdateJS("onchange", "!" & CStr(iRow), "this.checked");
If _IsSelected(sKey) Then Print " checked";
Print ">";
Print "</div>";
'Print "</div>";
Endif
If hItem.Image Then
@ -1306,6 +1297,8 @@ Public Sub _UpdateProperty(sProp As String, vValue As Variant)
Dim aProp As String[]
Dim hItem As _WebTreeItem
Dim sKey As String
Dim sCursor As String
Dim bCancel As Boolean
If sProp Begins "^" Then
@ -1341,6 +1334,19 @@ Public Sub _UpdateProperty(sProp As String, vValue As Variant)
_SetSelected(sKey, True)
Endif
Dec Me._NoRefresh
Else If sProp Begins "%" Then
If Object.CanRaise(Me, "Activate") Then
sCursor = $sCursor
$sCursor = FromBase64(Mid$(sProp, 2))
bCancel = Raise Activate
$sCursor = sCursor
Endif
If Not bCancel Then
hItem = $cItem[FromBase64(Mid$(sProp, 2))]
If hItem.Children Then hItem.Expanded = Not hItem.Expanded
Endif
Else If sProp = "#scroll" Then

38
comp/src/gb.web.gui/.src/Tree/WebTreeSelection.class
View file

@ -31,22 +31,6 @@ Private Sub GetParent() As WebTree
End
Public Sub Select(iStart As Integer, Optional iLength As Integer = 1)
Dim hParent As WebTree = GetParent()
Dim I As Integer
Dim hItem As _WebTreeItem
For I = iStart To iStart + iLength - 1
hItem = hParent._RowToItem(I)
If Not hItem Then Break
Keys[hItem.Key] = True
Next
End
Public Sub SelectItem(sKey As String, bSelected As Boolean)
If bSelected Then
@ -57,33 +41,19 @@ Public Sub SelectItem(sKey As String, bSelected As Boolean)
End
Public Sub UnSelect(iStart As Integer, Optional iLength As Integer = 1)
Dim hParent As WebTree = GetParent()
Dim I As Integer
Dim hItem As _WebTreeItem
For I = iStart To iStart + iLength - 1
hItem = hParent._RowToItem(I)
If Not hItem Then Break
Keys.Remove(hItem.Key)
Next
End
Public Sub UnSelectAll()
Public Sub UnSelectAll() As Boolean
If Keys.Count = 0 Then Return True
Keys.Clear
'Dump
End
Public Sub SelectAll()
Public Sub SelectAll() As Boolean
Dim sKey As String
If IsEverythingSelected() Then Return True
Keys.Clear
For Each sKey In GetParent().Keys
Keys[sKey] = True

26
comp/src/gb.web.gui/.src/Tree/_WebTreeColumns.class
View file

@ -74,24 +74,26 @@ Public Sub _Render()
If sStyle Then Print " style=\""; sStyle; "\"";
Print ">";
If I = 0 And If iMode And If hTree.ShowCheck Then
If iMode = Select.Multiple Then
Print "<input type=\"checkbox\"";
If I = 0 Then
If iMode = Select.Multiple And If hTree.ShowCheck Then
Print "<input class=\"gw-tree-check\" type=\"checkbox\"";
Print hTree._GetUpdateJS("onchange", "!!", "this.checked");
If hTree._IsEverythingSelected() Then Print " checked";
Print ">";
Endif
Print "<div class=\"gw-tree-header\">"; Html(hCol.Text); "</div>";
Else
If hCol.Text Then
Print "<div";
hCol._PrintAlignment()
Print ">";
Print Html(hCol.Text);
Print "</div>";
Else
Print "&nbsp;";
Endif
Endif
If hCol.Text Then
Print "<div";
hCol._PrintAlignment()
Print ">";
Print Html(hCol.Text);
Print "</div>";
Else
Print "&nbsp;";
Endif
Print "</th>"
Next

44
comp/src/gb.web.gui/.src/WebButton.class
View file

@ -5,7 +5,7 @@
Export
Inherits WebControl
Public Const _Properties As String = "*,Border=True,Text,Image{WebImage},Immediate,ShowArrow"
Public Const _Properties As String = "*,Border=True,Text,Image{WebImage},Immediate,ShowArrow,Default,Cancel"
'Public Const _DrawWith As String '= "Button"
Public Const _DefaultEvent As String = "Click"
Public Const _DefaultSize As String = "16,4"
@ -33,6 +33,9 @@ Property Immediate As Boolean
'' Return or set if the button displays an arrow
Property ShowArrow As Boolean
Property Default As Boolean
Property Cancel As Boolean
Private $sText As String
Private $sImage As String
Private $bImmediate As Boolean
@ -83,8 +86,12 @@ End
Public Sub _BeforeRender()
Dim vSave As Variant
Dim sClass As String
Print "<div"; Me._GetClassId();
sClass = "gw-button"
If Me.Default Then sClass &= " gw-button-default"
Print "<div"; Me._GetClassId(sClass);
If Me.Enabled Then
If $bImmediate Then
Print " onclick=\"";
@ -169,3 +176,36 @@ Private Sub ShowArrow_Write(Value As Boolean)
Me.Refresh
End
Private Function Default_Read() As Boolean
Return Me._GetTopLevel()._GetDefault() = Me.Id
End
Private Sub Default_Write(Value As Boolean)
If Value Then
Me._GetTopLevel()._SetDefault(Me)
Else If Default_Read() Then
Me._GetTopLevel()._SetDefault(Null)
Endif
End
Private Function Cancel_Read() As Boolean
Return Me._GetTopLevel()._GetCancel() = Me.Id
End
Private Sub Cancel_Write(Value As Boolean)
If Value Then
Me._GetTopLevel()._SetCancel(Me)
Else If Default_Read() Then
Me._GetTopLevel()._SetCancel(Null)
Endif
End

48
comp/src/gb.web.gui/.src/WebControl.class
View file

@ -87,6 +87,8 @@ Static Private $aStyleSheet As String[]
Static Public _NextName As String
Static Public _Shortcuts As New Collection
Public _Refresh As Boolean
Public _EventName As String
Public _Proxy As String
@ -1181,14 +1183,56 @@ Public Sub ToHTML() As String
End
Public Sub _RaiseKeyPress(cEvent As Variant)
Public Sub _RaiseKeyPress(cEvent As Variant) As Boolean
Dim cSave As Collection
Dim bCancel As Boolean
cSave = Key._Event
Key._Event = cEvent
Object.Raise(Me, "KeyPress")
bCancel = Raise KeyPress
Key._Event = cSave
WebForm.Print("_RaiseKeyPress: " & Str(bCancel))
Return bCancel
End
Public Sub _RegisterShortcut(sShortcut As String, sPrevious As String)
Dim aShortcut As Integer[]
Dim iPos As Integer
If sPrevious Then
sPrevious = String.UCase(sPrevious)
aShortcut = _Shortcuts[sPrevious]
If aShortcut Then
iPos = aShortcut.Find($iId)
If iPos Then aShortcut.Remove(iPos)
Endif
Endif
If sShortcut Then
sShortcut = String.UCase(sShortcut)
aShortcut = _Shortcuts[sShortcut]
If Not aShortcut Then
aShortcut = New Integer[]
_Shortcuts[sShortcut] = aShortcut
Endif
aShortcut.Add($iId)
Endif
End
Public Sub _GetTopLevel() As WebForm
Dim hForm As WebForm
Dim hParent As WebContainer
hForm = Me.Form
Do
hParent = hForm.Parent
If Not hParent Or If hForm._Window Then Return hForm
hForm = hForm.Form
Loop
End

195
comp/src/gb.web.gui/.src/WebForm.class
View file

@ -63,6 +63,7 @@ Static Public _DisableRefresh As Integer
Static Public _HasRefresh As Boolean
Static Public _InMessage As Integer
Static Public _CurrentPopup As WebForm
Static Public _CurrentModal As WebForm
Static Private _Current As WebForm
@ -79,6 +80,7 @@ Static Private $iEventLoopLevel As Integer
Static Private $aJavascript As New String[]
Static Private $aJavascriptBefore As New String[]
Static Private $cPreload As New Collection
Public _Loaded As Boolean
Public _Window As Integer
@ -103,6 +105,8 @@ Private $aJavascriptExternFiles As String[]
Private $aHeaders As String[]
Private $aShortcuts As String[]
Private $iDefault As Integer
Private $iCancel As Integer
'Private $bOpened As Boolean
@ -747,7 +751,8 @@ Public Sub _BeforeRender()
If Me.Class Then Print " "; Me.Class;
Print "\" id=\""; Me.Name; "\"";
Me._RenderStyleSheet()
Print Me._GetKeyPressHandler();
'Print Me._GetKeyPressHandler();
If Object.CanRaise(Me, "KeyPress") Or If $iDefault Or If $iCancel Then Print " onkeydown=\"gw.onkeydown(" & JS(Me.Name) & ", event)\"";
Print ">"
DisableShortcuts()
@ -757,6 +762,7 @@ End
Public Sub Render()
Dim sImage As String
Dim aPreload As String[]
Response.Buffered = True
Response.Begin
@ -770,11 +776,20 @@ Public Sub Render()
Print "<body"; Me._GetEventJS("onload", "open"); ">"
Print "<div id=\"gw-preload\" style=\"display:none;\">";
For Each sImage In ["error.png", "info.png", "question.png", "warning.png"]
Print "<img src=\""; Application.Root &/ "message" &/ sImage; "\">";
_AddPreload(Application.Root &/ "message" &/ sImage)
Next
Print "</div>"
For Each sImage In ["gw-arrow-down.png", "gw-arrow-left.png", "gw-arrow-right.png", "gw-arrow-up.png", "gw-close.png"]
_AddPreload(Application.Root &/ sImage)
Next
aPreload = New String[]
For Each $cPreload
aPreload.Add($cPreload.Key)
Next
$aJavascript.Add("gw.image.preload(" & JS(aPreload) & ")")
Print "<div id=\"gw-modal\" onclick=\"gw.window.onDownModal();\" onmouseover=\"gw.window.onDownModal(true);\"></div>"
Print "<div id=\"gw-lock\">"
@ -887,6 +902,23 @@ Private Sub Resizable_Write(Value As Boolean)
End
Private Sub HandleKeyPress(sName As String, vEvent As Variant)
Dim hCtrl As WebControl
Dim hForm As WebForm
If sName Then
hCtrl = WebControl.FromName(sName)
If hCtrl Then hCtrl._RaiseKeyPress(vEvent)
Else
hForm = _CurrentPopup
If Not hForm Then hForm = _CurrentModal
If Not hForm Then hForm = Me
hForm._RaiseKeyPress(vEvent)
Endif
End
Public Sub _HandleMessage()
Dim hCtrl As WebControl
@ -937,11 +969,7 @@ Public Sub _HandleMessage()
Case "keypress"
If aCmd[1] Then
hCtrl = WebControl.FromName(aCmd[1])
If hCtrl Then hCtrl._RaiseKeyPress(aCmd[2])
Endif
Me._RaiseKeyPress(aCmd[2])
HandleKeyPress(aCmd[1], aCmd[2])
Case "finish"
@ -1135,7 +1163,7 @@ Private Sub RunEventLoop()
Inc $iEventLoopLevel
iLevel = $iEventLoopLevel
PrintLog("RunEventLoop -> " & $iEventLoopLevel)
Raise Open
If $iEventLoopLevel = iLevel Then
@ -1167,6 +1195,7 @@ Public Sub ShowModal(Optional Parent As WebControl) As Variant
Dim hWindow As WebWindow
Dim vReturn As Variant
Dim hPrevious As WebForm
If Me.Parent Then Error.Raise("Form is embedded")
If _Window = 0 Then DoShow()
@ -1178,8 +1207,13 @@ Public Sub ShowModal(Optional Parent As WebControl) As Variant
If Parent Then hWindow.ParentControl = Parent.Name
Endif
hPrevious = _CurrentModal
_CurrentModal = Me
RunEventLoop
_CurrentModal = hPRevious
vReturn = $vEventLoopReturn
$vEventLoopReturn = Null
Return vReturn
@ -1409,15 +1443,46 @@ Private Sub FindShortcut(hParent As WebContainer, cShortcut As Collection)
End
Private Sub PurgeShortcuts()
Dim aShortcut As Integer[]
Dim I As Integer
Dim bRefresh As Boolean
' Remove shortcuts from deleted controls
For Each aShortcut In WebControl._Shortcuts
I = 0
While I < aShortcut.Count
If WebControl.FromId(aShortcut[I]) Then
Inc I
Else
aShortcut.Remove(I)
bRefresh = True
Endif
Wend
Next
If bRefresh Then Me.Refresh
End
Private Sub DisableShortcuts()
Dim cShortcut As Collection
Dim cShortcut As New Collection
Dim sShortcut As String
cShortcut = New Collection
FindShortcut($hMenuBar, cShortcut)
Dim aShortcut As String[]
PurgeShortcuts()
For Each aShortcut In WebControl._Shortcuts
If aShortcut.Count Then
sShortcut = WebControl._Shortcuts.Key
cShortcut[sShortcut] = True
Endif
Next
If $aShortcuts Then
For Each sShortcut In $aShortcuts
sShortcut = Trim(sShortcut)
@ -1432,39 +1497,63 @@ Private Sub DisableShortcuts()
End
Private Sub TriggerShortcut(hParent As WebContainer, sShortcut As String) As Boolean
Private Sub TriggerShortcut(sShortcut As String) As Boolean
Dim hChild As WebControl
Dim hMenu As WebMenu
Dim aShortcut As Integer[]
Dim iId As Integer
Dim hCtrl As WebControl
Dim hButton As WebButton
For Each hChild In hParent.Children
hMenu = hChild
If Not hMenu.Enabled Then Continue
If String.UCase(hMenu.Shortcut) = sShortcut Then
Object.Raise(hChild, "Click")
Return True
Else If hMenu.HasChildren() And If TriggerShortcut(hChild, sShortcut) Then
Return True
Endif
Next
PurgeShortcuts()
sShortcut = String.UCase(sShortcut)
aShortcut = WebControl._Shortcuts[sShortcut]
If aShortcut Then
For Each iId In aShortcut
hCtrl = WebControl.FromId(iId)
If Not hCtrl Then Continue
If hCtrl.IsHidden() Then Continue
If Not hCtrl.Enabled Then Continue
If hCtrl Is WebMenu Then
Object.Raise(hCtrl, "Click")
Return True
Endif
Next
Endif
'WebForm.Print("TriggerShortcut: " & Me.Name & ": " & sShortcut & " / " & $iDefault & " / " & $iCancel)
If $iDefault And If sShortcut = "ENTER" Then
hButton = WebControl.FromId($iDefault)
If hButton Then hButton.Click()
Return True
Else If $iCancel And If sShortcut = "ESCAPE" Then
hButton = WebControl.FromId($iCancel)
If hButton Then hButton.Click()
Return True
Endif
End
Public Sub _RaiseKeyPress(cEvent As Variant)
Public Sub _RaiseKeyPress(cEvent As Variant) As Boolean
Dim cSave As Collection
Dim sShortcut As String
Super._RaiseKeyPress(cEvent)
If Not $hMenuBar.HasChildren() Then Return
If Super._RaiseKeyPress(cEvent) Then Return True
cSave = Key._Event
Key._Event = cEvent
sShortcut = Key.Shortcut
Key._Event = cSave
TriggerShortcut($hMenuBar, String.UCase(sShortcut))
Return TriggerShortcut(sShortcut)
End
@ -1480,3 +1569,41 @@ Private Sub Shortcuts_Write(Value As String[])
$aShortcuts = Value
End
Public Sub _GetDefault() As Integer
Return $iDefault
End
Public Sub _SetDefault(hCtrl As WebControl)
If hCtrl Then
$iDefault = hCtrl.Id
Else
$iDefault = 0
Endif
End
Public Sub _GetCancel() As Integer
Return $iCancel
End
Public Sub _SetCancel(hCtrl As WebControl)
If hCtrl Then
$iCancel = hCtrl.Id
Else
$iCancel = 0
Endif
End
Static Public Sub _AddPreload(sLink As String)
$cPreload[sLink] = True
End

71
comp/src/gb.web.gui/lib.js
View file

@ -776,6 +776,7 @@ gw = {
$(gw.windows[i]).style.zIndex = 11 + i * 2;
gw.window.updateTitleBars();
$(id).focus();
if (send)
gw.update('', '#windows', gw.windows);
@ -1581,6 +1582,21 @@ gw = {
}
},
image:
{
preload: function(images)
{
var image;
var i;
for (i = 0; i < images.length; i++)
{
image = new Image();
image.src = images[i];
}
}
},
sound:
{
pause: function(id)
@ -1617,23 +1633,8 @@ gw = {
return shortcut;
},
onkeydown: function(event)
sendKeyPress: function(event, id)
{
if (!event.bubbles)
return;
var elt = document.activeElement;
var id = '';
while (elt)
{
id = elt.id;
if (id && id.indexOf(':') < 0)
break;
elt = elt.parentNode;
id = '';
}
gw.send(['keypress', id,
{
'altKey': event.altKey,
@ -1643,15 +1644,39 @@ gw = {
'shiftKey': event.shiftKey
}],
null);
},
onkeydown: function(id, event)
{
if (!event.bubbles)
return;
if (gw.shortcuts)
var elt = $(id);
while (elt)
{
var shortcut = gw.makeShortcut(event);
gw.log('shortcut -> ' + shortcut);
if (gw.shortcuts[shortcut])
event.preventDefault();
id = elt.id;
if (id && id.indexOf(':') < 0)
break;
elt = elt.parentNode;
id = '';
}
}
gw.sendKeyPress(event, id);
},
onshortcut: function(event)
{
if (event.bubbles && gw.shortcuts)
{
gw.sendKeyPress(event, '');
var shortcut = gw.makeShortcut(event);
if (gw.shortcuts[shortcut])
{
gw.log('shortcut -> ' + shortcut);
event.preventDefault();
}
}
},
}
document.onkeydown = gw.onkeydown;
document.onkeydown = gw.onshortcut;

32
comp/src/gb.web.gui/style.css
View file

@ -69,6 +69,10 @@ P:first-child,UL:first-child,OL:first-child {
user-select: none;
}
.gw-button-default {
border-width: 2px;
}
.gw-button:active {
background-color: #E0E0E0;
}
@ -695,9 +699,19 @@ P:first-child,UL:first-child,OL:first-child {
.gw-table-index {
text-align: right;
border-right: solid 1px #F0F0F0;
border-right: solid 1px #C0C0C0;
font-size: smaller;
font-weight: bold;
background-color: #E0E0E0;
padding: 0.25em 0.5em;
position: sticky;
left: 0;
z-index: 1;
box-sizing: border-box;
}
TH.gw-table-index {
z-index: 2 !important;
}
/*.gw-table > DIV > TABLE > TBODY > TR > TD:last-child {
@ -985,6 +999,12 @@ TABLE.gw-calendar > TBODY > TR > TD.gw-date-current {
.gw-tree-item {
position: relative;
display: flex;
align-items: center;
}
.gw-tree-header {
display: inline;
vertical-align: top;
}
.gw-tree-arrow {
@ -1026,11 +1046,6 @@ TABLE.gw-calendar > TBODY > TR > TD.gw-date-current {
box-sizing: border-box;
}
TH.gw-tree-check {
padding: 0 0.5em;
vertical-align: middle;
}
.gw-tree > DIV > TABLE > THEAD > TR > TH:last-child {
border-right: none;
}
@ -1049,3 +1064,8 @@ TD.gw-table-check {
.gw-tree > DIV > TABLE > TBODY > TR:hover {
background-image: url('data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAICAYAAADED76LAAAACXBIWXMAAA7EAAAOxAGVKw4bAAAAFUlEQVQYlWNkYGDgYcADmPBJDh8FABV4ABwe4TuyAAAAAElFTkSuQmCC');
}
.gw-tree-check {
margin: 0;
margin-right: 0.25em;
}

7
gb.compress.zlib/src/main.c
View file

@ -188,9 +188,10 @@ static void u_String(char **target,unsigned int *lent,char *source,unsigned int
.avail_in = len,
.next_in = (Bytef *) source,
};
unsigned long pos = 0;
size_t pos = 0;
*lent = 2 * len;
*lent = 2; // * len;
GB.Alloc((void **) target, *lent);
stream.avail_out = *lent;
@ -204,6 +205,8 @@ static void u_String(char **target,unsigned int *lent,char *source,unsigned int
break;
case Z_BUF_ERROR:
pos = (unsigned long) (stream.next_out - (unsigned long) *target);
if (stream.avail_in == 0) // BM: No idea why zlib returns Z_BUF_ERROR and not Z_STREAM_END in that case.
goto out;
*lent += *lent / 2;
GB.Realloc((void **) target, *lent);
stream.avail_out = *lent - pos;

5
gb.qt5/src/x11/main.cpp
View file

@ -320,8 +320,7 @@ static void window_remap(QWidget *window)
static void window_set_properties(QWidget *window, int which, QT_WINDOW_PROP *prop)
{
//X11_flush();
qApp->sync();
X11_flush();
if (which & (PROP_STACKING | PROP_SKIP_TASKBAR))
{
@ -345,7 +344,7 @@ static void window_set_properties(QWidget *window, int which, QT_WINDOW_PROP *pr
if (which & PROP_STICKY)
X11_window_set_desktop(window->effectiveWinId(), window->isVisible(), prop->sticky ? 0xFFFFFFFF : X11_get_current_desktop());
qApp->sync();
X11_flush();
}
static void window_set_user_time(QWidget *window, int timestamp)