Add a colored label on top of the project tree that displays the current branch.

[DEVELOPMENT ENVIRONMENT]
* NEW: Add a colored label on top of the project tree that displays the current branch.
  The background color of the label is automatically computed from an hash of the branch name.
  The 'master' branch is always black.
This commit is contained in:
gambas 2021-10-13 17:35:50 +02:00
parent 74f0797f7b
commit 6795f418fd
11 changed files with 421 additions and 295 deletions

File diff suppressed because it is too large Load diff

View file

@ -2949,6 +2949,17 @@ Public Sub OnVersionControlChange()
VersionControl.InitControlProjectMenu(mnuVersionControlWith)
mnuVersionControlWith.Visible = mnuVersionControlWith.Children.Count
If VersionControl.Enabled Then
panBranchColor.Show
txtSearchProject.Button = False
Else
panBranchColor.Hide
txtSearchProject.Button = True
Endif
dwgBranchColor.Visible = VersionControl.Enabled
dwgBranchColor.Refresh
End
Public Sub mnuVcBranchSet_Click()
@ -3202,3 +3213,30 @@ Public Sub btnOpenStartup_Click()
End
Public Sub dwgBranchColor_Draw()
Dim DS As Integer
Dim sBranch As String
DS = Desktop.Scale \ 2
sBranch = VersionControl.GetCurrentBranch()
Paint.Rectangle(DS, DS, Paint.W - DS, Paint.H - DS * 2, DS * 4)
Paint.Background = VersionControl.GetBranchColor(sBranch)
If Application.DarkTheme Then Paint.Background = Color.Invert(Paint.Background, True)
Paint.Fill
Paint.Background = Color.TextBackground
Paint.Font.Bold = True
sBranch = Paint.TrimText(sBranch, Paint.W - DS * 5)
Paint.DrawText(sBranch, DS, DS, Paint.W - DS, Paint.H - DS * 2, Align.Center)
End
Public Sub btnCloseTree_Click()
txtSearchProject_Click
End

View file

@ -1287,8 +1287,22 @@
Orientation = Align.Left
Separator = True
Transparent = True
{ panBranchColor HBox
MoveScaled(2,1,27,4)
Padding = 1
{ dwgBranchColor DrawingArea
MoveScaled(0,0,15,4)
Visible = False
Expand = True
}
{ btnCloseTree ToolButton
MoveScaled(20,0,4,4)
Picture = Picture["icon:/small/close"]
}
}
{ panSearchProject HBox
MoveScaled(1,0,28,5)
MoveScaled(1,7,28,5)
Padding = 1
{ btnUseInheritance ToolButton
MoveScaled(0,0,4,4)
ToolTip = ("Dispose class files according to inheritance")
@ -1312,7 +1326,7 @@
}
}
{ Separator4 Separator
MoveScaled(0,6,9,0)
MoveScaled(0,13,9,0)
}
{ tvwProject TreeView
MoveScaled(1,18,20,45)
@ -1321,7 +1335,7 @@
Border = False
}
{ timSearchProject #Timer
#MoveScaled(22,13)
#MoveScaled(22,18)
Delay = 500
}
}

View file

@ -1848,3 +1848,10 @@ Public Sub sldBackgroundBrightness_Change()
'RefreshBackground
End
' Public Sub btnShowBranchColor_Click()
'
' Settings["/Version/ShowBranchColor"] = btnShowBranchColor.Value
' VersionControl.Refresh
'
' End

View file

@ -1,7 +1,7 @@
# Gambas Form File 3.0
{ Form Form
MoveScaled(0,0,102,66)
MoveScaled(0,0,102,69)
Action = "option"
Text = ("Preferences")
Icon = Picture["icon:/small/options"]
@ -31,7 +31,7 @@
}
}
{ ipnOption IconPanel
MoveScaled(1,1,95,64)
MoveScaled(1,1,95,67)
Arrangement = Arrange.Vertical
Spacing = True
Count = 10

View file

@ -1756,7 +1756,7 @@ Public Sub UpdateTitle()
If sTitle Then sTitle &= " - "
sTitle &= Name & " " & FormatVersion()
VersionControl.GetBranches(ByRef sBranch)
sBranch = VersionControl.GetCurrentBranch()
If sBranch Then sTitle &= " (" & sBranch & ")"
If ReadOnly Then sTitle &= " [" & ("read-only") & "]"
@ -3931,7 +3931,7 @@ Public Sub WriteProject(Optional bComponentDoNotChange As Boolean, Optional bMak
GetVersion()
sVer = FormatVersion()
If VersionAddBranch Then
VersionControl.GetBranches(ByRef sBranch)
sBranch = VersionControl.GetCurrentBranch()
If Not sBranch Then sBranch = "?"
sVer &= " (" & sBranch & ")"
Endif
@ -7186,7 +7186,7 @@ Public Sub GetTranslationEngines() As String[]
Dim sEngine As String
Dim aEngine As New String[]
Exec ["trans", "-S"] To sResult
Try Exec ["trans", "-S"] To sResult
For Each sEngine In Split(Trim(sResult), "\n")
If sEngine Begins "* " Then sEngine = Mid$(sEngine, 2)
@ -7199,4 +7199,3 @@ Public Sub GetTranslationEngines() As String[]
Return aEngine.Sort()
End

View file

@ -29,7 +29,6 @@ Private $aComponents As New String[]
Private $sTranslatedTitle As String
Private $sTranslatedDescription As String
Private $bVersionAddBranch As Boolean
Private $dDate As Date
Private Sub GetProjectPath(sPath As String) As String
@ -127,17 +126,12 @@ Private Sub ReadProject()
Type = Project.TYPE_COMPONENT
End Select
Case "versionaddbranch"
$bVersionAddBranch = CInt(sVal)
End Select
Next
If $bVersionAddBranch Then
sBranch = CVersionControlGit.GetCurrentBranch($sPath)
If sBranch Then $sVersion &= " (" & sBranch & ")"
Endif
sBranch = VersionControl.GetBranchFromDir($sPath)
If sBranch Then $sVersion &= " (" & sBranch & ")"
Close #hFile

View file

@ -31,7 +31,6 @@
{ mnuTranslator Menu
Text = ("Translation engine")
{ Menu3 Menu
Text = ("Menu3")
}
}
{ Menu2 Menu

View file

@ -89,6 +89,10 @@ Public Sub CleanUp((sPath) As String)
End
Public Sub GetCurrentBranch() As String
End
Public Sub GetBranches(ByRef (sCurrent) As String) As String[]
End

View file

@ -88,6 +88,12 @@ Public Sub Check() As Boolean
End
Public Sub GetCurrentBranch() As String
Return Trim(RunShell("git branch --show-current"))
End
Public Sub GetBranches(ByRef sCurrent As String) As String[]
Dim sResult As String
@ -126,19 +132,6 @@ Public Sub GetBranches(ByRef sCurrent As String) As String[]
End
Static Public Sub GetCurrentBranch(Optional sDir As String) As String
Dim sCurrent As String
If Not sDir Then sDir = Project.Dir
sCurrent = Trim(VersionControl.Shell("cd " & Shell(sDir) & " && git branch --show-current", True))
'If sCurrent = "master" Then sCurrent = ""
Return sCurrent
End
Public Sub Diff(sPath As String, Optional bFull As Boolean, bNoWhiteSpace As Boolean) As String
Dim sDiff As String

View file

@ -28,8 +28,14 @@ Private $sLastResult As String
Public LANG_ENV As String[] = ["LC_ALL=C.UTF-8", "LANG=C.UTF-8", "LANGUAGE=C.UTF-8"]
Public Const DELIM_CHANGE As String = ("This line and the following will be ignored")
Public Enum ACCEPT_OURS = 1, ACCEPT_THEIRS = 2
Private $bCancel As Boolean
Private $sCurrentBranch As String
Private $cBranchColor As New Collection
Private $aBranchColor As Integer[] = [&HFF0000, &HFF007F, &HFF00FF, &H7F00FF, &H0000FF, &H007FFF, &H00E0E0, &H00E000, &HE0E000, &HFFBF00, &HFF7F00, &HC00000, &HC00060, &HC000C0, &H00A0A0, &H00A000, &HA0A000, &HC09000, &HC05C00]
Private Sub OnVersionControlChange()
FMain.OnVersionControlChange
@ -74,6 +80,7 @@ Public Sub Refresh()
Endif
Endif
$sCurrentBranch = ""
$bAuth = False
CheckPaths
OnVersionControlChange
@ -595,6 +602,13 @@ Private Function Output_Read() As String
End
Public Sub GetCurrentBranch() As String
If Not $sCurrentBranch Then $sCurrentBranch = $hVC.GetCurrentBranch()
Return $sCurrentBranch
End
Public Sub GetBranches(ByRef sCurrent As String) As String[]
Return $hVC.GetBranches(ByRef sCurrent)
@ -646,7 +660,8 @@ Public Sub SetBranch(sBranch As String)
Inc Application.Busy
$hVC.SetBranch(sBranch)
GetBranches(ByRef sCurrent)
$sCurrentBranch = ""
sCurrent = GetCurrentBranch()
If sCurrent = sBranch Then Project.Reload
Dec Application.Busy
@ -654,7 +669,7 @@ Public Sub SetBranch(sBranch As String)
ShowError(Subst(("Unable to switch to branch `&1`."), sBranch))
Endif
Project.UpdateTitle
Refresh()
End
@ -711,3 +726,61 @@ Public Sub NeedMove() As Boolean
End
Public Sub GetBranchColor(sBranch As String) As Integer
Dim iColor As Integer
Dim I As Integer
Dim iHash As Integer
Dim iPos As Integer
Try iColor = $cBranchColor[sBranch]
If Error Then
' static size_t fnv1a_hash(const char* cp)
' {
' size_t hash = 0x811c9dc5;
' while (*cp) {
' hash ^= (unsigned char) *cp++;
' hash *= 0x01000193;
' }
' return hash;
' }
sBranch = LCase(sBranch)
Select Case sBranch
Case "master"
iColor = &H606060
Case Else
iHash = 5381
For I = 1 To Len(sBranch)
iPos = Asc(sBranch, I) - Asc("a") + 1
If iPos < 1 Or If iPos > 26 Then iPos = 27
iHash += iPos
iHash = (iHash * 33) Mod $aBranchColor.Count
Next
iColor = $aBranchColor[iHash]
End Select
$cBranchColor[sBranch] = iColor
Endif
Return iColor
End
Public Sub GetBranchFromDir(sDir As String) As String
Dim sResult As String
Try sResult = Trim(VersionControl.Shell("cd " & Shell(sDir) & " && git branch --show-current"))
If sResult Then Return sResult
End