Merge pull request IDEMSInternational#8707 from lloyddewit/testRInsight

Upgraded to new script library that provides foundation for R key words
Patowhiz · Jan 11, 2024 · 819984c · 819984c
2 parents cf2bde1 + 123aeb2
commit 819984c
Show file tree

Hide file tree

Showing 10 changed files with 79 additions and 188 deletions.
diff --git a/.gitignore b/.gitignore
@@ -255,4 +255,5 @@ installer/Output/
 
 # RScript package and dependencies
 /packages/RScript.*/
+/packages/RInsightF461.*/
 /packages/System.Collections.Specialized.*/
diff --git a/instat/Model/Options/OutputFont.vb b/instat/Model/Options/OutputFont.vb
@@ -14,7 +14,7 @@
 ' You should have received a copy of the GNU General Public License
 ' along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-Imports RScript
+Imports RInsightF461
 
 ''' <summary>
 ''' Fonts and Colours for all text within the output screen
@@ -27,8 +27,6 @@ Public Class OutputFont
     Public Shared Property RCommentFont As Font = clsInstatOptionsDefaults.DEFAULTfntComment
     Public Shared Property RConstantStringColour As Color = clsInstatOptionsDefaults.DEFAULTclrScript
     Public Shared Property RConstantStringFont As Font = clsInstatOptionsDefaults.DEFAULTfntScript
-    Public Shared Property REndScriptColour As Color = clsInstatOptionsDefaults.DEFAULTclrScript
-    Public Shared Property REndScriptFont As Font = clsInstatOptionsDefaults.DEFAULTfntScript
     Public Shared Property REndStatementColour As Color = clsInstatOptionsDefaults.DEFAULTclrScript
     Public Shared Property REndStatementFont As Font = clsInstatOptionsDefaults.DEFAULTfntScript
     Public Shared Property RFunctionNameColour As Color = clsInstatOptionsDefaults.DEFAULTclrScript
@@ -62,42 +60,38 @@ Public Class OutputFont
     ''' </summary>
     ''' <param name="scriptType"></param>
     ''' <returns></returns>
-    Public Shared Function GetColourForScriptType(scriptType As clsRToken.typToken) As Color
+    Public Shared Function GetColourForScriptType(scriptType As RToken.TokenTypes) As Color
         Select Case scriptType
-            Case clsRToken.typToken.RSyntacticName
+            Case RToken.TokenTypes.RSyntacticName
                 Return RSyntacticNameColour
-            Case clsRToken.typToken.RFunctionName
+            Case RToken.TokenTypes.RFunctionName
                 Return RFunctionNameColour
-            Case clsRToken.typToken.RKeyWord
+            Case RToken.TokenTypes.RKeyWord
                 Return RKeyWordColour
-            Case clsRToken.typToken.RConstantString
+            Case RToken.TokenTypes.RConstantString
                 Return RConstantStringColour
-            Case clsRToken.typToken.RComment
+            Case RToken.TokenTypes.RComment
                 Return RCommentColour
-            Case clsRToken.typToken.RSpace
+            Case RToken.TokenTypes.RSpace
                 Return RSpaceColour
-            Case clsRToken.typToken.RBracket
+            Case RToken.TokenTypes.RBracket
                 Return RBracketColour
-            Case clsRToken.typToken.RSeparator
+            Case RToken.TokenTypes.RSeparator
                 Return RSeparatorColour
-            Case clsRToken.typToken.REndStatement
+            Case RToken.TokenTypes.REndStatement
                 Return REndStatementColour
-            Case clsRToken.typToken.REndScript
-                Return REndScriptColour
-            Case clsRToken.typToken.RNewLine
+            Case RToken.TokenTypes.RNewLine
                 Return RNewLineColour
-            Case clsRToken.typToken.ROperatorUnaryLeft
+            Case RToken.TokenTypes.ROperatorUnaryLeft
                 Return ROperatorUnaryLeftColour
-            Case clsRToken.typToken.ROperatorUnaryRight
+            Case RToken.TokenTypes.ROperatorUnaryRight
                 Return ROperatorUnaryRightColour
-            Case clsRToken.typToken.ROperatorBinary
+            Case RToken.TokenTypes.ROperatorBinary
                 Return ROperatorBinaryColour
-            Case clsRToken.typToken.ROperatorBracket
+            Case RToken.TokenTypes.ROperatorBracket
                 Return ROperatorBracketColour
-            Case clsRToken.typToken.RPresentation
+            Case RToken.TokenTypes.RPresentation
                 Return RPresentationColour
-            Case clsRToken.typToken.RInvalid
-                Return RInvalidColour
             Case Else
                 Return Color.Black
         End Select
@@ -108,42 +102,38 @@ Public Class OutputFont
     ''' </summary>
     ''' <param name="scriptType"></param>
     ''' <returns></returns>
-    Public Shared Function GetFontForScriptType(scriptType As clsRToken.typToken) As Font
+    Public Shared Function GetFontForScriptType(scriptType As RToken.TokenTypes) As Font
         Select Case scriptType
-            Case clsRToken.typToken.RSyntacticName
+            Case RToken.TokenTypes.RSyntacticName
                 Return RSyntacticNameFont
-            Case clsRToken.typToken.RFunctionName
+            Case RToken.TokenTypes.RFunctionName
                 Return RFunctionNameFont
-            Case clsRToken.typToken.RKeyWord
+            Case RToken.TokenTypes.RKeyWord
                 Return RKeyWordFont
-            Case clsRToken.typToken.RConstantString
+            Case RToken.TokenTypes.RConstantString
                 Return RConstantStringFont
-            Case clsRToken.typToken.RComment
+            Case RToken.TokenTypes.RComment
                 Return RCommentFont
-            Case clsRToken.typToken.RSpace
+            Case RToken.TokenTypes.RSpace
                 Return RSpaceFont
-            Case clsRToken.typToken.RBracket
+            Case RToken.TokenTypes.RBracket
                 Return RBracketFont
-            Case clsRToken.typToken.RSeparator
+            Case RToken.TokenTypes.RSeparator
                 Return RSeparatorFont
-            Case clsRToken.typToken.REndStatement
+            Case RToken.TokenTypes.REndStatement
                 Return REndStatementFont
-            Case clsRToken.typToken.REndScript
-                Return REndScriptFont
-            Case clsRToken.typToken.RNewLine
+            Case RToken.TokenTypes.RNewLine
                 Return RNewLineFont
-            Case clsRToken.typToken.ROperatorUnaryLeft
+            Case RToken.TokenTypes.ROperatorUnaryLeft
                 Return ROperatorUnaryLeftFont
-            Case clsRToken.typToken.ROperatorUnaryRight
+            Case RToken.TokenTypes.ROperatorUnaryRight
                 Return ROperatorUnaryRightFont
-            Case clsRToken.typToken.ROperatorBinary
+            Case RToken.TokenTypes.ROperatorBinary
                 Return ROperatorBinaryFont
-            Case clsRToken.typToken.ROperatorBracket
+            Case RToken.TokenTypes.ROperatorBracket
                 Return ROperatorBracketFont
-            Case clsRToken.typToken.RPresentation
+            Case RToken.TokenTypes.RPresentation
                 Return RPresentationFont
-            Case clsRToken.typToken.RInvalid
-                Return RInvalidFont
             Case Else
                 Return New Font("Ariel", 12, FontStyle.Bold)
         End Select

diff --git a/instat/Model/Output/clsOutputElement.vb b/instat/Model/Output/clsOutputElement.vb
@@ -14,7 +14,7 @@
 ' You should have received a copy of the GNU General Public License
 ' along with this program.  If not, see <http://www.gnu.org/licenses/>.
 Imports System.IO
-Imports RScript
+Imports RInsightF461
 
 ''' <summary>
 ''' Output element for an R script. 
@@ -97,23 +97,18 @@ Public Class clsOutputElement
         Get
             Dim _lstRScriptElements As New List(Of clsRScriptElement)
             Try
-                Dim rScript As New clsRScript("")
-                Dim lstTokens As List(Of clsRToken) = rScript.GetLstTokens(rScript.GetLstLexemes(_strScript)) 'rScript.lstTokens
+                Dim lstTokens As List(Of RToken) = New RTokenList(_strScript).TokensFlat
                 If lstTokens IsNot Nothing Then
                     For Each rToken In lstTokens
                         _lstRScriptElements.Add(New clsRScriptElement With
                     {
-                        .Text = rToken.strTxt,
-                        .Type = rToken.enuToken
+                        .Text = rToken.Lexeme.Text,
+                        .Type = rToken.TokenType
                     })
                     Next
                 End If
             Catch ex As Exception
-                MessageBox.Show("Unable to parse the following R Script: '" & _strScript & "'." &
-                            Environment.NewLine & ex.Message,
-                            "Developer Error",
-                            MessageBoxButtons.OK,
-                            MessageBoxIcon.Error)
+                Return New List(Of clsRScriptElement)
             End Try
             Return _lstRScriptElements
         End Get

diff --git a/instat/Model/Output/clsRScriptElement.vb b/instat/Model/Output/clsRScriptElement.vb
@@ -14,12 +14,12 @@
 ' You should have received a copy of the GNU General Public License
 ' along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-Imports RScript
+Imports RInsightF461
 
 ''' <summary>
 ''' R script element containing the text and type token of the text
 ''' </summary>
 Public Class clsRScriptElement
     Public Property Text As String
-    Public Property Type As clsRToken.typToken
+    Public Property Type As RToken.TokenTypes
 End Class
diff --git a/instat/UserControl/ucrOutputPage.vb b/instat/UserControl/ucrOutputPage.vb
@@ -15,7 +15,8 @@
 ' along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 Imports System.Runtime.InteropServices
-Imports RScript
+Imports RInsightF461
+
 ''' <summary>
 ''' Output page for R outputs
 ''' </summary>
@@ -164,8 +165,13 @@ Public Class ucrOutputPage
          .BorderStyle = BorderStyle.None
         }
 
+        Dim formattedRScript As List(Of clsRScriptElement) = outputElement.FormattedRScript
         'if settings are not available or both show commands and comments settings are enabled then just show the whole script
-        FillRichTextWithRScriptBasedOnSettings(richTextBox, outputElement.FormattedRScript)
+        If formattedRScript.Count > 0 Then
+            FillRichTextWithRScriptBasedOnSettings(richTextBox, formattedRScript)
+        Else
+            AddFormatedTextToRichTextBox(richTextBox, outputElement.Script, OutputFont.RPresentationFont, OutputFont.RPresentationColour)
+        End If
 
         'if no contents added just exit sub
         If richTextBox.TextLength = 0 Then
@@ -192,15 +198,15 @@ Public Class ucrOutputPage
             If frmMain.clsInstatOptions.bIncludeCommentDefault Then
                 'show comments only
                 For Each line As clsRScriptElement In formattedRScript
-                    If line.Type = clsRToken.typToken.RComment Then
+                    If line.Type = RToken.TokenTypes.RComment Then
                         AddFormatedTextToRichTextBox(richTextBox, line.Text, OutputFont.GetFontForScriptType(line.Type), OutputFont.GetColourForScriptType(line.Type))
                     End If
                 Next
 
             ElseIf frmMain.clsInstatOptions.bCommandsinOutput Then
                 'show command lines that are not comments
                 For Each line As clsRScriptElement In formattedRScript
-                    If Not (line.Type = clsRToken.typToken.RComment) Then
+                    If Not (line.Type = RToken.TokenTypes.RComment) Then
                         AddFormatedTextToRichTextBox(richTextBox, line.Text, OutputFont.GetFontForScriptType(line.Type), OutputFont.GetColourForScriptType(line.Type))
                     End If
                 Next
@@ -418,7 +424,13 @@ Public Class ucrOutputPage
     Private Sub AddElementToRichTextBox(element As clsOutputElement, richText As RichTextBox)
         Select Case element.OutputType
             Case OutputType.Script
-                FillRichTextWithRScriptBasedOnSettings(richText, element.FormattedRScript)
+                Dim formattedRScript As List(Of clsRScriptElement) = element.FormattedRScript
+                'if settings are not available or both show commands and comments settings are enabled then just show the whole script
+                If formattedRScript.Count > 0 Then
+                    FillRichTextWithRScriptBasedOnSettings(richText, formattedRScript)
+                Else
+                    AddFormatedTextToRichTextBox(richText, element.Script, OutputFont.RPresentationFont, OutputFont.RPresentationColour)
+                End If
             Case OutputType.TextOutput
                 Dim strOutput As String = ""
                 If element.IsFile Then

diff --git a/instat/clsInstatOptions.vb b/instat/clsInstatOptions.vb
@@ -384,7 +384,6 @@ Imports RDotNet
         OutputFont.RBracketFont = fntNew
         OutputFont.RSeparatorFont = fntNew
         OutputFont.REndStatementFont = fntNew
-        OutputFont.REndScriptFont = fntNew
         OutputFont.RNewLineFont = fntNew
         OutputFont.ROperatorUnaryLeftFont = fntNew
         OutputFont.ROperatorUnaryRightFont = fntNew
@@ -401,7 +400,6 @@ Imports RDotNet
         OutputFont.RBracketColour = clrNew
         OutputFont.RSeparatorColour = clrNew
         OutputFont.REndStatementColour = clrNew
-        OutputFont.REndScriptColour = clrNew
         OutputFont.RNewLineColour = clrNew
         OutputFont.ROperatorUnaryLeftColour = clrNew
         OutputFont.ROperatorUnaryRightColour = clrNew