From 3bbc4c973487c178e77e01e86f8a73a88a01f48c Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 10:36:58 +0800 Subject: [PATCH 01/61] 1.3.3 --- package-lock.json | 4 ++-- package.json | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package-lock.json b/package-lock.json index 89e76b7..f82b8ae 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "vba-lsp", - "version": "1.3.2", + "version": "1.3.3", "lockfileVersion": 2, "requires": true, "packages": { "": { "name": "vba-lsp", - "version": "1.3.2", + "version": "1.3.3", "hasInstallScript": true, "license": "MIT", "devDependencies": { diff --git a/package.json b/package.json index 9d114bf..1744d86 100644 --- a/package.json +++ b/package.json @@ -5,7 +5,7 @@ "icon": "images/vba-lsp-icon.png", "author": "SSlinky", "license": "MIT", - "version": "1.3.2", + "version": "1.3.3", "repository": { "type": "git", "url": "https://github.com/SSlinky/VBA-LanguageServer" From 557867eaa22420f0874cfb46a5778c96c23bed62 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 11:24:51 +0800 Subject: [PATCH 02/61] Better snippets --- snippets/vba.json | 69 ++++++++++++++++------------------------------- 1 file changed, 23 insertions(+), 46 deletions(-) diff --git a/snippets/vba.json b/snippets/vba.json index ddcc259..5517788 100644 --- a/snippets/vba.json +++ b/snippets/vba.json @@ -1,5 +1,5 @@ { - "Public Property Let": { + "VBA Pro: Public Property Get Let": { "prefix": "proplet", "description": "Property let and get with backing store", "body": [ @@ -17,7 +17,7 @@ "$0" ] }, - "Public Property Set": { + "VBA Pro: Public Property Get Set": { "prefix": "propset", "description": "Property set and get with backing store", "body": [ @@ -35,7 +35,7 @@ "$0" ] }, - "Public Property Get": { + "VBA Pro: Public Property Get": { "prefix": "propget", "description": "Property get only", "body": [ @@ -47,7 +47,7 @@ "" ] }, - "Subroutine": { + "VBA Pro: Subroutine": { "prefix": "sub", "description": "Subroutine", "body": [ @@ -65,7 +65,7 @@ "End Sub" ] }, - "Function": { + "VBA Pro: Function": { "prefix": "func", "description": "Function", "body": [ @@ -87,7 +87,7 @@ "End Function" ] }, - "EnumExcl": { + "VBA Pro: Enum Exclusive": { "prefix": "enumexcl", "description": "Exclusive Enum", "body": [ @@ -98,18 +98,18 @@ "End Enum" ] }, - "EnumIncl": { + "VBA Pro: Enum Inclusive": { "prefix": "enumincl", "description": "Inclusive Enum", "body": [ "Public Enum ${1:Identifier}", - " ${2:Enum1} = 2 ^^ 1", - " ${3:Enum2} = 2 ^^ 2", - " ${4:Enum3} = 2 ^^ 3", + " ${2:Enum1} = 2 ^ 1", + " ${3:Enum2} = 2 ^ 2", + " ${4:Enum3} = 2 ^ 3", "End Enum" ] }, - "ForLoop": { + "VBA Pro: ForLoop": { "prefix": "fori", "description": "For Loop", "body": [ @@ -119,7 +119,7 @@ "Next $1" ] }, - "ForEachLoop": { + "VBA Pro: ForEachLoop": { "prefix": "foreach", "description": "For Each Loop", "body": [ @@ -128,7 +128,7 @@ "Next $1" ] }, - "If": { + "VBA Pro: If Block": { "prefix": "ifblock", "description": "If Block", "body": [ @@ -137,7 +137,7 @@ "End If" ] }, - "IfElse": { + "VBA Pro: IfElse": { "prefix": "ifelse", "description": "If Else Block", "body": [ @@ -147,7 +147,7 @@ "End If" ] }, - "TypeCheckAssignment": { + "VBA Pro: TypeCheckAssignment": { "prefix": "typecheck", "description": "Object type check assignment", "body": [ @@ -158,7 +158,7 @@ "End If$0" ] }, - "Case": { + "VBA Pro: Case": { "prefix": "case", "description": "Select Case", "body": [ @@ -169,14 +169,14 @@ "End Select" ] }, - "Event": { + "VBA Pro: Event": { "prefix": "event", "description": "Event", "body": [ "Public Event ${1:Identifier}($3)" ] }, - "Constructor": { + "VBA Pro: Constructor": { "prefix": "ctor", "description": "Class_Initialize", "body": [ @@ -185,7 +185,7 @@ "End Sub" ] }, - "Destructor": { + "VBA Pro: Destructor": { "prefix": "dtor", "description": "Class_Terminate", "body": [ @@ -194,7 +194,7 @@ "End Sub" ] }, - "Base Class Template": { + "VBA Pro: Class Template": { "prefix": "class", "description": "Basic class", "body": [ @@ -208,7 +208,7 @@ "Attribute VB_Creatable = False", "Attribute VB_PredeclaredId = False", "Attribute VB_Exposed = False", - "' Copyright 2024 Sam Vanderslink", + "' Copyright 2024 ${2:Name}", "' ", "' Permission is hereby granted, free of charge, to any person obtaining a copy ", "' of this software and associated documentation files (the \"Software\"), to deal ", @@ -273,12 +273,12 @@ "" ] }, - "Base Module Template": { + "VBA Pro: Module Template": { "prefix": "module", "description": "Basic module", "body": [ "Attribute VB_Name = \"${1:ModuleName}\"", - "' Copyright 2024 Sam Vanderslink", + "' Copyright 2024 ${2:Name}", "' ", "' Permission is hereby granted, free of charge, to any person obtaining a copy ", "' of this software and associated documentation files (the \"Software\"), to deal ", @@ -301,28 +301,5 @@ "Option Explicit", "$0" ] - }, - "Unit Test Template": { - "prefix": "test", - "description": "Unit test basic template", - "body": [ - "Private Function TestList_${1:Identifier}() As TestResult", - "Attribute TestList_$1.VB_Description = \"${2:Dosctring}.\"", - "' $2.", - " Dim tr As New TestResult", - "", - "' Arrange", - " $0", - "", - "' Act", - "", - "", - "' Assert", - "", - "", - "Finally:", - " Set TestList_$1 = tr", - "End Function" - ] } } From 5e425d8008895f5052bedc50572f62a966dfce59 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 12:07:38 +0800 Subject: [PATCH 03/61] Fixes #3 --- vba.language-configuration.json | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/vba.language-configuration.json b/vba.language-configuration.json index d4062cb..91918b0 100644 --- a/vba.language-configuration.json +++ b/vba.language-configuration.json @@ -7,11 +7,13 @@ ["[", "]"], ["(", ")"] ], - "folding": { - "markers": { - "start": "^\\s*(Private|Protected|Friend|Public|Sub|Function|If|While|Do|For|Loop)\\b", - "end": "^\\s*(End|Next|Wend)\\b" - } - }, + "autoClosingPairs": [ + { "open": "\"", "close": "\""} + ], + "surroundingPairs": [ + [ "(", ")" ], + [ "[", "]" ], + [ "\"", "\"" ] + ], "wordPattern": "(-?\\d*\\.\\d\\w*)|([^\\`\\~\\!\\@\\#\\%\\^\\&\\*\\(\\)\\-\\=\\+\\[\\{\\]\\}\\\\\\|\\;\\:\\'\\\"\\,\\.\\<\\>\\/\\?\\s]+)", } \ No newline at end of file From f2bb7c040fee9835deabbf0151185447ec74259f Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 15:49:40 +0800 Subject: [PATCH 04/61] args no longer require spaces between=assignment --- client/src/syntaxes/vba.tmLanguage.yaml | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 99e6e9b..ba4ff17 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -371,22 +371,20 @@ repository: - include: "#paramArray" - include: "#functionCall" - include: "#argsVariable" - - include: "#argsLiteral" - include: "#language" + - include: "#argsLiteral" repository: argsVariable: - match: (?i),?\s*(Optional\s+)?((?:ByVal|ByRef)\s+)?([a-z][a-z0-9_]*)(?:\s*(\bas\s+[a-z][a-z0-9_]*))?\b(\s+=\s+[^,)]*)? + match: (?i),?\s*((?:Optional\s+)?(?:ByVal|ByRef)\s+)?([a-z][a-z0-9_]*)(?:\s+(as\s+[a-z][a-z0-9_]*))?(\s*=\s*[^,)]+)? captures: - 1: - name: storage.type.modifier.vba - 2: + 1: # Optional? ByVal|ByRef? name: storage.type.modifier.vba - 3: + 2: # Identifier name: variable.parameter.vba - 4: + 3: # As Type? patterns: - include: "#types" - 5: + 4: patterns: - include: "#language" From 5cad513b26adb2e2cccc7eaf3f6a4d896ef09217 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 16:53:40 +0800 Subject: [PATCH 05/61] Support for inline methods --- client/src/syntaxes/vba.tmLanguage.yaml | 27 +++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index ba4ff17..77f80cb 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -14,6 +14,7 @@ repository: - include: "#comments" # Handle comments here so they aren't broken by other stuff. - include: "#strings" # Handle strings here so they aren't broken by other stuff. - include: "#labels" # Handle labels first so they aren't handled by lines. + - include: "#inlineMethod" # Try not to be too sad people can, and do, do this. - include: "#methodSignature" - include: "#continuations" # Consume continuations so they "continue" other matches. - include: "#enum" @@ -564,10 +565,32 @@ repository: patterns: - include: "#arguments" + inlineMethod: + name: source.inline-method.please-dont.vba + match: (?i)^\s*((?:Public|Private)?\b\s*(?:(?:Sub|Function)|Property\s+(?:Let|Get|Set)))\s+([a-z][a-z0-9_]*)\s*\((.+)?\)(\s+as\s+[a-z][a-z0-9_]*)?:(.*)?:\s*(End\s+(?:Sub|Function|Property)) + captures: + 1: # Method type + name: storage.type.method.vba + 2: # Identifier + name: entity.name.function.vba + 3: # Arguments? + patterns: + - include: "#arguments" + 4: # Return type? + patterns: + - include: "#types" + 5: # Method lines + patterns: + - include: "#fileStructure" + 6: # End method + name: storage.type.method.close.vba + + + methodSignature: name: source.method.signature.vba - begin: '(?i)^\s*((?:Public|Private)?\b\s*(?:(?:Sub|Function)|Property\s+(?:Let|Get|Set)))\s+([a-z][a-z0-9_]*)\s*(\()' - end: '(?i)(\))\s+(as\s+[a-z][a-z0-9_]*)?' + begin: (?i)^\s*((?:Public|Private)?\b\s*(?:(?:Sub|Function)|Property\s+(?:Let|Get|Set)))\s+([a-z][a-z0-9_]*)\s*(\() + end: (?i)(\))\s+(as\s+[a-z][a-z0-9_]*)? beginCaptures: 1: name: storage.type.method.vba From 41d6fb658dbe37f1630a4f15de044df72a2abd57 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 28 May 2024 22:08:33 +0800 Subject: [PATCH 06/61] Added caret to typeHint rule --- server/src/antlr/vba.g4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 3b59580..9bf4e73 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -684,7 +684,7 @@ literal: type_: (baseType | complexType) (WS? LPAREN WS? RPAREN)?; -typeHint: '&' | '%' | '#' | '!' | '@' | '$'; +typeHint: '&' | '%' | '#' | '!' | '@' | '$' | POW; visibility: PRIVATE | PUBLIC | FRIEND | GLOBAL; From c50f62cea5518d6796bcc1be948844f773606d02 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:35:40 +0800 Subject: [PATCH 07/61] Updated error handling --- server/src/project/parser/vbaSyntaxParser.ts | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index c31c750..3681c54 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -61,10 +61,8 @@ export class SyntaxParser { } parse(document: VbaClassDocument | VbaModuleDocument) { - console.info('Parsing the document.'); const listener = new VbaTreeWalkListener(document); const parser = this.createParser(document.textDocument); - ParseTreeWalker.DEFAULT.walk( listener, parser.startRule() @@ -77,6 +75,7 @@ export class SyntaxParser { parser.removeErrorListeners(); parser.addErrorListener(new VbaErrorListener()); + parser.errorHandler = new VbaErrorHandler(); return parser; } } @@ -111,7 +110,6 @@ class VbaTreeWalkListener implements vbaListener { }; exitEnumerationStmt = (_: EnumerationStmtContext) => { - console.warn("Entered enum statement."); this.document.deregisterScopedElement(); }; @@ -157,7 +155,6 @@ class VbaTreeWalkListener implements vbaListener { }; enterVariableStmt = (ctx: VariableStmtContext) => { - console.warn("Entered value statement. " + ctx.text); const element = new VariableDeclarationsElement(ctx, this.document.textDocument); element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); }; @@ -168,6 +165,16 @@ class VbaTreeWalkListener implements vbaListener { }; } +class VbaErrorHandler extends DefaultErrorStrategy { + recover(recognizer: Parser, e: RecognitionException): void { + const inputStream = recognizer.inputStream; + if (!recognizer.isMatchedEOF) { + inputStream.consume(); + } + this.endErrorCondition(recognizer); + } +} + class VbaErrorListener extends ConsoleErrorListener { syntaxError(recognizer: Recognizer, offendingSymbol: T, line: number, charPositionInLine: number, msg: string, e: RecognitionException | undefined): void { super.syntaxError(recognizer, offendingSymbol, line, charPositionInLine, msg, e); @@ -176,6 +183,5 @@ class VbaErrorListener extends ConsoleErrorListener { const y = recognizer.getErrorHeader(e); console.log(y); } - recognizer.inputStream?.consume(); } } From 253bda1ff0196652c25290ef95082e0be9356c25 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:52:08 +0800 Subject: [PATCH 08/61] Support for Type declarations --- server/src/project/elements/memory.ts | 22 ++++++++++++++++++++ server/src/project/parser/vbaSyntaxParser.ts | 6 ++++++ 2 files changed, 28 insertions(+) diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 2d07aa1..63a7bc1 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -114,6 +114,28 @@ export class ConstDeclarationsElement extends BaseVariableDeclarationStatementEl } } +export class TypeDeclarationElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { + tokenType: SemanticTokenTypes; + tokenModifiers: SemanticTokenModifiers[] = []; + identifier: IdentifierElement; + symbolKind: SymbolKind; + + constructor(context: TypeStmtContext, document: TextDocument) { + super(context, document); + this.symbolKind = SymbolKind.Struct; + this.tokenType = SemanticTokenTypes.struct; + this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); + } + + get name(): string { return this.identifier.text; } + get symbolInformation(): SymbolInformation { + return SymbolInformationFactory.create( + this, this.symbolKind + ); + } + +} + export class VariableDeclarationsElement extends BaseVariableDeclarationStatementElement { declarations: VariableDeclarationElement[] = []; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 3681c54..1a63b48 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -159,6 +159,12 @@ class VbaTreeWalkListener implements vbaListener { element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); }; + enterTypeStmt = (ctx: TypeStmtContext) => { + const element = new TypeDeclarationElement(ctx, this.document.textDocument); + this.document.registerSymbolInformation(element); + this.document.registerSemanticToken(element); + }; + enterOperatorsStmt = (ctx: OperatorsStmtContext) => { const element = new OperatorElement(ctx, this.document.textDocument); this.document.registerDiagnosticElement(element); From 1383f0d474f7553d3b0ca037dbd22bf1049c8fca Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:54:40 +0800 Subject: [PATCH 09/61] Separate folding and normal blocks --- server/src/antlr/vba.g4 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 9bf4e73..4167c15 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -76,7 +76,8 @@ attributeStmt: WS? ',' WS? literal )*; -block: blockStmt (endOfStatement blockStmt)* endOfStatement; +block: + ((blockStmt | foldingBlockStmt) endOfStatement)+; blockStmt: lineLabel @@ -96,7 +97,6 @@ blockStmt: | exitStmt | explicitCallStmt | filecopyStmt - | foldingBlockStmt | getStmt | goSubStmt | goToStmt From be2bb96012c6b1534aee4eb0346ab4cf4bc50c33 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:55:42 +0800 Subject: [PATCH 10/61] Removed "unknown" lines in favour of error recovery --- server/src/antlr/vba.g4 | 24 ++---------------------- 1 file changed, 2 insertions(+), 22 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 4167c15..1092eca 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -22,7 +22,7 @@ module: moduleBody? endOfLine* WS?; moduleHeader: - (endOfLine | unknownLine)* + endOfLine* (moduleVerson endOfLine*)? moduleConfig? endOfLine* moduleAttributes? endOfLine* @@ -141,8 +141,7 @@ blockStmt: | widthStmt | writeStmt | implicitCallStmt_InBlock - | implicitCallStmt_InStmt - | unknownLine; + | implicitCallStmt_InStmt; foldingBlockStmt: doLoopStmt @@ -845,25 +844,6 @@ endOfLine: WS? (NEWLINE | comment | remComment) WS?; endOfStatement: (endOfLine | WS? COLON WS?)*; -unknownToken: (IDENTIFIER | NWS)+; - -anyValidToken: ( - DIM - | visibility - | ambiguousIdentifier - | AS - | literal - | baseType - | complexType - | '!' - | '.' - ); - -unknownLine: ( - (anyValidToken WS?)* WS? unknownToken WS? ( - anyValidToken WS? - )* - )+; // lexer rules -------------------------------------------------------------------------------- From 120a637a0257036f0f9970b0507b373aa3f4d9f7 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:56:21 +0800 Subject: [PATCH 11/61] Bug fix: operator statements --- server/src/antlr/vba.g4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 1092eca..f330ec4 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -513,13 +513,13 @@ valueStmt: operatorsStmt: (GEQ | LEQ + | GT | LT | NEQ | EQ | POW | DIV | MULT - | MOD | PLUS | MINUS | AMPERSAND From 66102f17963dba22b9a144658ef40543a66cd363 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:56:56 +0800 Subject: [PATCH 12/61] Improved readability and removed labels --- server/src/antlr/vba.g4 | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index f330ec4..685aef5 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -236,10 +236,11 @@ forEachStmt: )?; forNextStmt: - FOR WS ambiguousIdentifier typeHint? (WS asTypeClause)? WS? EQ WS? valueStmt WS TO WS valueStmt - ( - WS STEP WS valueStmt - )? endOfStatement block? NEXT (WS ambiguousIdentifier)?; + FOR WS ambiguousIdentifier typeHint? WS? + EQ WS? valueStmt WS TO WS valueStmt + (WS STEP WS valueStmt)? endOfStatement + block? + NEXT (WS ambiguousIdentifier)?; getStmt: GET WS fileNumber WS? ',' WS? valueStmt? WS? ',' WS? valueStmt; @@ -249,10 +250,14 @@ goSubStmt: GOSUB WS valueStmt; goToStmt: GOTO WS valueStmt; ifThenElseStmt: - IF WS ifConditionStmt WS THEN WS blockStmt ( - WS ELSE WS blockStmt - )? # inlineIfThenElse - | ifBlockStmt ifElseIfBlockStmt* ifElseBlockStmt? END_IF # blockIfThenElse; + inlineIfThenElseStmt + | blockIfThenElseStmt; + +inlineIfThenElseStmt: + IF WS ifConditionStmt WS THEN WS blockStmt (WS ELSE WS blockStmt)?; + +blockIfThenElseStmt: + ifBlockStmt ifElseIfBlockStmt* ifElseBlockStmt? END_IF; ifBlockStmt: IF WS ifConditionStmt WS THEN endOfStatement block?; From d6a44e6bfe012e2d68eb364e29b69380a0a79f53 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 10:59:30 +0800 Subject: [PATCH 13/61] Update imports and clean logging lines --- server/src/project/elements/memory.ts | 2 +- server/src/project/parser/vbaSyntaxParser.ts | 6 +++--- server/src/project/workspace.ts | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 63a7bc1..f5194d7 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,4 +1,4 @@ -import { AmbiguousIdentifierContext, AsTypeClauseContext, ConstStmtContext, ConstSubStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, MethodStmtContext, VariableStmtContext, VariableSubStmtContext } from '../../antlr/out/vbaParser'; +import { AmbiguousIdentifierContext, AsTypeClauseContext, ConstStmtContext, ConstSubStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, MethodStmtContext, TypeStmtContext, VariableStmtContext, VariableSubStmtContext } from '../../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 1a63b48..601479c 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,17 +1,17 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; -import { ANTLRInputStream, CommonTokenStream, ConsoleErrorListener, RecognitionException, Recognizer } from 'antlr4ts'; +import { ANTLRInputStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, Parser, RecognitionException, Recognizer } from 'antlr4ts'; import { ErrorNode } from 'antlr4ts/tree/ErrorNode'; import { ParseTreeWalker } from 'antlr4ts/tree/ParseTreeWalker'; import { vbaLexer as VbaLexer } from '../../antlr/out/vbaLexer'; -import { AttributeStmtContext, ConstStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, FoldingBlockStmtContext, MethodStmtContext, ModuleContext, ModuleHeaderContext, OperatorsStmtContext, VariableStmtContext, vbaParser as VbaParser } from '../../antlr/out/vbaParser'; +import { AttributeStmtContext, ConstStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, FoldingBlockStmtContext, MethodStmtContext, ModuleContext, ModuleHeaderContext, OperatorsStmtContext, TypeStmtContext, VariableStmtContext, vbaParser as VbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; import { FoldableElement } from '../elements/special'; -import { ConstDeclarationsElement, EnumBlockDeclarationElement, EnumMemberDeclarationElement, MethodBlockDeclarationElement, VariableDeclarationsElement } from '../elements/memory'; +import { ConstDeclarationsElement, EnumBlockDeclarationElement, EnumMemberDeclarationElement, MethodBlockDeclarationElement, TypeDeclarationElement, VariableDeclarationsElement } from '../elements/memory'; import { ModuleElement } from '../elements/module'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; diff --git a/server/src/project/workspace.ts b/server/src/project/workspace.ts index 493fe51..60adf41 100644 --- a/server/src/project/workspace.ts +++ b/server/src/project/workspace.ts @@ -121,7 +121,7 @@ class WorkspaceEvents { } private _onDidChangeConfiguration(params: DidChangeConfigurationParams): void { - console.log(`onDidChangeConfiguration: ${params}`); + console.log(`onDidChangeConfiguration: ${params.settings}`); } private _onDidChangeWatchedFiles(params: DidChangeWatchedFilesParams) { From e62863ae9617103fdc3c2032ed524d50a8a47101 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 11:08:18 +0800 Subject: [PATCH 14/61] Chaining methods --- server/src/project/document.ts | 12 ++++--- server/src/project/parser/vbaSyntaxParser.ts | 35 ++++++++++---------- 2 files changed, 25 insertions(+), 22 deletions(-) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index b692297..7a1357d 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -155,19 +155,21 @@ export abstract class BaseProjectDocument { /** * Registers a semantic token element for tracking with the SemanticTokenManager. * @param element element The element that has a semantic token. - * @returns void. + * @returns this for chaining. */ - registerSemanticToken = (element: HasSemanticToken): void => { + registerSemanticToken = (element: HasSemanticToken) => { this._semanticTokens.add(element); + return this; }; /** * Registers a SymbolInformation. * @param element The element that has symbol information. - * @returns a number for some reason. + * @returns this for chaining. */ - registerSymbolInformation = (element: HasSymbolInformation): number => { - return this._symbolInformations.push(element.symbolInformation); + registerSymbolInformation = (element: HasSymbolInformation) => { + this._symbolInformations.push(element.symbolInformation); + return this; }; /** Get document information */ diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 601479c..30ad63b 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -103,10 +103,10 @@ class VbaTreeWalkListener implements vbaListener { enterEnumerationStmt = (ctx: EnumerationStmtContext) => { const element = new EnumBlockDeclarationElement(ctx, this.document.textDocument); - this.document.registerFoldableElement(element); - this.document.registerSemanticToken(element); - this.document.registerSymbolInformation(element); - this.document.registerScopedElement(element); + this.document.registerFoldableElement(element) + .registerSemanticToken(element) + .registerSymbolInformation(element) + .registerScopedElement(element); }; exitEnumerationStmt = (_: EnumerationStmtContext) => { @@ -115,8 +115,8 @@ class VbaTreeWalkListener implements vbaListener { enterEnumerationStmt_Constant = (ctx: EnumerationStmt_ConstantContext) => { const element = new EnumMemberDeclarationElement(ctx, this.document.textDocument); - this.document.registerSymbolInformation(element); - this.document.registerSemanticToken(element); + this.document.registerSymbolInformation(element) + .registerSemanticToken(element); }; enterFoldingBlockStmt = (ctx: FoldingBlockStmtContext) => { @@ -126,10 +126,11 @@ class VbaTreeWalkListener implements vbaListener { enterMethodStmt = (ctx: MethodStmtContext) => { const element = new MethodBlockDeclarationElement(ctx, this.document.textDocument); - this.document.registerNamedElement(element); - this.document.registerFoldableElement(element); - this.document.registerSymbolInformation(element); - this.document.registerScopedElement(element); + this.document.registerNamedElement(element) + .registerFoldableElement(element) + .registerSymbolInformation(element) + .registerSemanticToken(element) + .registerScopedElement(element); }; exitMethodStmt = (_: MethodStmtContext) => { @@ -138,15 +139,15 @@ class VbaTreeWalkListener implements vbaListener { enterModule = (ctx: ModuleContext) => { const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); - this.document.registerAttributeElement(element); - this.document.registerScopedElement(element); + this.document.registerAttributeElement(element) + .registerScopedElement(element); }; exitModule = (_: ModuleContext) => { const element = this.document.deregisterAttributeElement() as ModuleElement; - this.document.registerSymbolInformation(element); - this.document.deregisterScopedElement(); - this.document.deregisterAttributeElement(); + this.document.registerSymbolInformation(element) + .deregisterScopedElement() + .deregisterAttributeElement(); }; enterModuleHeader = (ctx: ModuleHeaderContext) => { @@ -161,8 +162,8 @@ class VbaTreeWalkListener implements vbaListener { enterTypeStmt = (ctx: TypeStmtContext) => { const element = new TypeDeclarationElement(ctx, this.document.textDocument); - this.document.registerSymbolInformation(element); - this.document.registerSemanticToken(element); + this.document.registerSymbolInformation(element) + .registerSemanticToken(element); }; enterOperatorsStmt = (ctx: OperatorsStmtContext) => { From e5248ce178f33ae4892f6bbc1194a21f0f4b64cc Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 11:14:54 +0800 Subject: [PATCH 15/61] Added wend keyword --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 77f80cb..af7eb33 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -156,7 +156,7 @@ repository: flowLoop: name: keyword.control.flow.loop.vba - match: (?i)\b(do|exit\s+do|while|until|loop|for|each|in|to|exit\s+for|next|with)\b + match: (?i)\b(do|exit\s+do|while|wend|until|loop|for|each|in|to|exit\s+for|next|with)\b forEachLoop: name: meta.flow.foreach.vba From d296d2c3385628175478d391c8945203177b065a Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 11:26:11 +0800 Subject: [PATCH 16/61] 1.3.4 --- package-lock.json | 4 ++-- package.json | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package-lock.json b/package-lock.json index f82b8ae..ad561d1 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "vba-lsp", - "version": "1.3.3", + "version": "1.3.4", "lockfileVersion": 2, "requires": true, "packages": { "": { "name": "vba-lsp", - "version": "1.3.3", + "version": "1.3.4", "hasInstallScript": true, "license": "MIT", "devDependencies": { diff --git a/package.json b/package.json index 1744d86..b38531c 100644 --- a/package.json +++ b/package.json @@ -5,7 +5,7 @@ "icon": "images/vba-lsp-icon.png", "author": "SSlinky", "license": "MIT", - "version": "1.3.3", + "version": "1.3.4", "repository": { "type": "git", "url": "https://github.com/SSlinky/VBA-LanguageServer" From 31596df9ac37a95a8983a79934b9d1b0081d2ea4 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 12:26:58 +0800 Subject: [PATCH 17/61] methods sort --- server/src/project/parser/vbaSyntaxParser.ts | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 30ad63b..7f5eb2d 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -154,10 +154,10 @@ class VbaTreeWalkListener implements vbaListener { const element = new FoldableElement(ctx, this.document.textDocument); this.document.registerFoldableElement(element); }; - - enterVariableStmt = (ctx: VariableStmtContext) => { - const element = new VariableDeclarationsElement(ctx, this.document.textDocument); - element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); + + enterOperatorsStmt = (ctx: OperatorsStmtContext) => { + const element = new OperatorElement(ctx, this.document.textDocument); + this.document.registerDiagnosticElement(element); }; enterTypeStmt = (ctx: TypeStmtContext) => { @@ -165,10 +165,10 @@ class VbaTreeWalkListener implements vbaListener { this.document.registerSymbolInformation(element) .registerSemanticToken(element); }; - - enterOperatorsStmt = (ctx: OperatorsStmtContext) => { - const element = new OperatorElement(ctx, this.document.textDocument); - this.document.registerDiagnosticElement(element); + + enterVariableStmt = (ctx: VariableStmtContext) => { + const element = new VariableDeclarationsElement(ctx, this.document.textDocument); + element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); }; } From 95bbadae38f67c0e38ecc2288a15adda4135bc0b Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 12:40:21 +0800 Subject: [PATCH 18/61] Fixed bug with module header --- client/src/syntaxes/vba.tmLanguage.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index af7eb33..db6b1f4 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -11,6 +11,7 @@ patterns: repository: fileStructure: patterns: + - include: "#moduleHeader" - include: "#comments" # Handle comments here so they aren't broken by other stuff. - include: "#strings" # Handle strings here so they aren't broken by other stuff. - include: "#labels" # Handle labels first so they aren't handled by lines. @@ -53,7 +54,6 @@ repository: main: patterns: - - include: "#moduleHeader" - include: "#declareFunctionSignature" - include: "#methodSignature" - include: "#variableDeclarations" @@ -449,7 +449,7 @@ repository: moduleAttributeBlock: name: entity.other.attribute-name.block.vba begin: (?i)^VERSION - end: ^(?i)End + end: (?i)^END patterns: - include: "#comments" - include: "#literals" From 45d08e018d50a87575ebe830a7cc5438c2f5c683 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 21:02:06 +0800 Subject: [PATCH 19/61] Support for while/wend blocks --- server/src/capabilities/diagnostics.ts | 8 +++++ server/src/project/elements/flow.ts | 34 ++++++++++++++++++++ server/src/project/parser/vbaSyntaxParser.ts | 8 ++++- 3 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 server/src/project/elements/flow.ts diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 0f2c86f..270a17e 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -27,4 +27,12 @@ export class MultipleOperatorsDiagnostic extends BaseDiagnostic { constructor(range: Range) { super(range); } +} + +export class WhileWendDeprecatedDiagnostic extends BaseDiagnostic { + message = "The Do...Loop statement provides a more structured and flexible way to perform looping."; + severity = DiagnosticSeverity.Information; + constructor(range: Range) { + super(range); + } } \ No newline at end of file diff --git a/server/src/project/elements/flow.ts b/server/src/project/elements/flow.ts new file mode 100644 index 0000000..ef59874 --- /dev/null +++ b/server/src/project/elements/flow.ts @@ -0,0 +1,34 @@ +import { ParserRuleContext } from 'antlr4ts'; +import { BaseContextSyntaxElement, HasDiagnosticCapability } from './base'; +import { TextDocument } from 'vscode-languageserver-textdocument'; +import { ValueStmtContext, WhileWendStmtContext } from '../../antlr/out/vbaParser'; +import { Diagnostic } from 'vscode-languageserver'; +import { WhileWendDeprecatedDiagnostic } from '../../capabilities/diagnostics'; + + +class BaseLoopElement extends BaseContextSyntaxElement { + constructor(context: ParserRuleContext, document: TextDocument) { + super(context, document); + } +} + + +export class WhileWendLoopElement extends BaseLoopElement implements HasDiagnosticCapability { + diagnostics: Diagnostic[] = []; + valueStatement: ValueStatementElement; + + constructor(context: WhileWendStmtContext, document: TextDocument) { + super(context, document); + this.valueStatement = new ValueStatementElement(context.valueStmt(), document); + } + + evaluateDiagnostics(): void { + this.diagnostics.push(new WhileWendDeprecatedDiagnostic(this.valueStatement.range)); + } +} + +class ValueStatementElement extends BaseContextSyntaxElement { + constructor(context: ValueStmtContext, document: TextDocument) { + super(context, document); + } +} \ No newline at end of file diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 7f5eb2d..e4718a4 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -6,7 +6,7 @@ import { ErrorNode } from 'antlr4ts/tree/ErrorNode'; import { ParseTreeWalker } from 'antlr4ts/tree/ParseTreeWalker'; import { vbaLexer as VbaLexer } from '../../antlr/out/vbaLexer'; -import { AttributeStmtContext, ConstStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, FoldingBlockStmtContext, MethodStmtContext, ModuleContext, ModuleHeaderContext, OperatorsStmtContext, TypeStmtContext, VariableStmtContext, vbaParser as VbaParser } from '../../antlr/out/vbaParser'; +import { AttributeStmtContext, ConstStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, FoldingBlockStmtContext, MethodStmtContext, ModuleContext, ModuleHeaderContext, OperatorsStmtContext, TypeStmtContext, VariableStmtContext, vbaParser as VbaParser, WhileWendStmtContext } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -16,6 +16,7 @@ import { ModuleElement } from '../elements/module'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; import { OperatorElement } from '../elements/operator'; +import { WhileWendLoopElement } from '../elements/flow'; export class SyntaxParser { private static _lockIdentifier = 0; @@ -170,6 +171,11 @@ class VbaTreeWalkListener implements vbaListener { const element = new VariableDeclarationsElement(ctx, this.document.textDocument); element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); }; + + enterWhileWendStmt = (ctx: WhileWendStmtContext) => { + const element = new WhileWendLoopElement(ctx, this.document.textDocument); + this.document.registerDiagnosticElement(element); + }; } class VbaErrorHandler extends DefaultErrorStrategy { From fa8f4a36aab81a77648305e9b512fcc733632685 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 21:05:02 +0800 Subject: [PATCH 20/61] Better async support and trigger parse on doc open --- server/src/project/document.ts | 60 ++++++++++++-------------- server/src/project/workspace.ts | 74 ++++++++++++++++++++++++++++----- 2 files changed, 90 insertions(+), 44 deletions(-) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index 7a1357d..6d34679 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -26,9 +26,13 @@ export abstract class BaseProjectDocument { protected _symbolInformations: SymbolInformation[] = []; protected _semanticTokens: SemanticTokensManager = new SemanticTokensManager(); - isBusy = false; + protected _isBusy = true; abstract symbolKind: SymbolKind + get Busy() { + return this._isBusy; + } + get activeAttributeElement() { return this._attributeElements?.at(-1); } @@ -63,20 +67,33 @@ export abstract class BaseProjectDocument { return this._semanticTokens.getSemanticTokens(range); }; - async languageServerSymbolInformationAsync(token: CancellationToken): Promise { - while (this.isBusy) { - await sleep(5); - if (token.isCancellationRequested) { - return []; - } - } + languageServerFoldingRanges(): FoldingRange[] { + return this._foldableElements; + } + + languageServerSymbolInformation(): SymbolInformation[] { return this._symbolInformations; } + languageServerDiagnostics(): PublishDiagnosticsParams { + this._hasDiagnosticElements.forEach(e => + e.evaluateDiagnostics() + ); + return { + uri: this.textDocument.uri, + diagnostics: this._hasDiagnosticElements + .map((e) => e.diagnostics).flat(1) }; + } + parseAsync = async (token: CancellationToken): Promise => { - this.isBusy = true; + if (!this._isBusy) { + console.log("Parser busy!"); + console.log(`v${this.textDocument.version}: ${this.textDocument.uri}`); + this._isBusy = true; + } if (await (new SyntaxParser()).parseAsync(this, token)) { - this.isBusy = false; + console.log("Parser idle!"); + this._isBusy = false; } this._hasDiagnosticElements.forEach(element => { element.evaluateDiagnostics; @@ -94,7 +111,6 @@ export abstract class BaseProjectDocument { } registerDiagnosticElement(element: HasDiagnosticCapability) { - console.log("Registering diagnostic element"); this._hasDiagnosticElements.push(element); } @@ -171,28 +187,6 @@ export abstract class BaseProjectDocument { this._symbolInformations.push(element.symbolInformation); return this; }; - - /** Get document information */ - async getFoldingRanges(token: CancellationToken): Promise { - while (this.isBusy) { - await sleep(5); - if (token.isCancellationRequested) { - return []; - } - } - this.workspace.connection.console.info('Processing request for Folding Range'); - return this._foldableElements; - } - - getDiagnostics(): PublishDiagnosticsParams { - this._hasDiagnosticElements.forEach(e => - e.evaluateDiagnostics() - ); - return { - uri: this.textDocument.uri, - diagnostics: this._hasDiagnosticElements - .map((e) => e.diagnostics).flat(1) }; - } } diff --git a/server/src/project/workspace.ts b/server/src/project/workspace.ts index 60adf41..d309481 100644 --- a/server/src/project/workspace.ts +++ b/server/src/project/workspace.ts @@ -1,8 +1,9 @@ -import { CancellationToken, CancellationTokenSource, CompletionItem, CompletionParams, DidChangeConfigurationNotification, DidChangeConfigurationParams, DidChangeWatchedFilesParams, DocumentSymbolParams, FoldingRange, FoldingRangeParams, Hover, HoverParams, PublishDiagnosticsParams, SemanticTokensParams, SemanticTokensRangeParams, SymbolInformation, TextDocuments, WorkspaceFoldersChangeEvent, _Connection } from 'vscode-languageserver'; +import { CancellationToken, CancellationTokenSource, CompletionItem, CompletionParams, DidChangeConfigurationNotification, DidChangeConfigurationParams, DidChangeWatchedFilesParams, DidOpenTextDocumentParams, DocumentSymbolParams, FoldingRange, FoldingRangeParams, Hover, HoverParams, PublishDiagnosticsParams, SemanticTokensParams, SemanticTokensRangeParams, SymbolInformation, TextDocuments, WorkspaceFoldersChangeEvent, _Connection } from 'vscode-languageserver'; import { BaseProjectDocument } from './document'; import { LanguageServerConfiguration } from '../server'; import { hasConfigurationCapability } from '../capabilities/workspaceFolder'; import { TextDocument } from 'vscode-languageserver-textdocument'; +import { sleep } from '../utils/helpers'; /** @@ -62,7 +63,7 @@ class WorkspaceEvents { private readonly _configuration: LanguageServerConfiguration; private _parseCancellationToken?: CancellationTokenSource; - activeDocument?: BaseProjectDocument; + private _activeDocument?: BaseProjectDocument; constructor(params: {connection: _Connection, workspace: Workspace, configuration: LanguageServerConfiguration}) { this._connection = params.connection; @@ -74,8 +75,41 @@ class WorkspaceEvents { this._documents.listen(params.connection); } + /** + * + * @param version the target document version (zero for any version). + * @param token the cancellation token. + * @returns the document when it is ready or undefined. + */ + private async activeParsedDocument(version: number, token: CancellationToken): Promise { + let document: BaseProjectDocument | undefined; + document = this._activeDocument; + + // Sleep between attempting to grab the document. + // Loop while we have undefined or an earlier version. + while (!document || document.textDocument.version < version) { + if (token.isCancellationRequested) { + return; + } + await sleep(5); + document = this._activeDocument; + } + + // Return if the version somehow outpaced us. + if (version > 0 && document.textDocument.version != version) { + return; + } + + // Return the parsed document. + while (document.Busy) { + await sleep(5); + } + return document; + } + private initialiseConnectionEvents(connection: _Connection) { connection.onInitialized(() => this._onInitialized()); + connection.onDidOpenTextDocument(params => this._onDidOpenTextDocument(params)); connection.onCompletion(params => this._onCompletion(params)); connection.onCompletionResolve(item => this._onCompletionResolve(item)); connection.onDidChangeConfiguration(params => this._onDidChangeConfiguration(params)); @@ -90,11 +124,11 @@ class WorkspaceEvents { connection.onRequest((method: string, params: object | object[] | any) => { switch (method) { case 'textDocument/semanticTokens/full': { - return this.activeDocument?.languageServerSemanticTokens(); + return this._activeDocument?.languageServerSemanticTokens(); } case 'textDocument/semanticTokens/range': { const rangeParams = params as SemanticTokensRangeParams; - return this.activeDocument?.languageServerSemanticTokens(rangeParams.range); + return this._activeDocument?.languageServerSemanticTokens(rangeParams.range); } default: console.error(`Unresolved request path: ${method}`); @@ -103,7 +137,7 @@ class WorkspaceEvents { } private _sendDiagnostics() { - this._connection.sendDiagnostics(this.activeDocument?.getDiagnostics() ?? {uri: "", diagnostics: []}); + this._connection.sendDiagnostics(this._activeDocument?.languageServerDiagnostics() ?? {uri: "", diagnostics: []}); } private _initialiseDocumentsEvents() { @@ -134,11 +168,16 @@ class WorkspaceEvents { } private async _onDocumentSymbolAsync(params: DocumentSymbolParams, token: CancellationToken): Promise { - return await this.activeDocument?.languageServerSymbolInformationAsync(token) ?? []; + const document = await this.activeParsedDocument(0, token); + return document?.languageServerSymbolInformation() ?? []; } private async _onFoldingRanges(params: FoldingRangeParams, token: CancellationToken): Promise { - return await this._workspace.activeDocument?.getFoldingRanges(token) ?? []; + // VSCode is an eager beaver and sends the folding range request before onDidChange or onDidOpen. + await sleep(200); + const document = await this.activeParsedDocument(0, token); + const result = document?.languageServerFoldingRanges(); + return result ?? []; } private _onHover(params: HoverParams): Hover { @@ -164,15 +203,28 @@ class WorkspaceEvents { * This event handler is called whenever a `TextDocuments` is changed. * @param doc The document that changed. */ - async onDidChangeContentAsync(doc: TextDocument) { + async _onDidOpenTextDocument(params: DidOpenTextDocumentParams) { + await this._handleChangeOrOpenAsync(TextDocument.create( + params.textDocument.uri, + params.textDocument.languageId, + params.textDocument.version, + params.textDocument.text + )); + } + + async onDidChangeContentAsync(document: TextDocument) { + await this._handleChangeOrOpenAsync(document); // this._parseCancellationToken?.cancel(); // this._parseCancellationToken?.dispose(); + } - this.activeDocument = BaseProjectDocument.create(this._workspace, doc); + protected async _handleChangeOrOpenAsync(document: TextDocument) { + this._activeDocument = BaseProjectDocument.create(this._workspace, document); this._parseCancellationToken = new CancellationTokenSource(); - await this.activeDocument.parseAsync(this._parseCancellationToken.token); + await this._activeDocument.parseAsync(this._parseCancellationToken.token); this._sendDiagnostics(); this._parseCancellationToken = undefined; - this._workspace.activateDocument(this.activeDocument); + this._workspace.activateDocument(this._activeDocument); } } + From 55c62427c64817f3786cc8fbe530e11f205424b8 Mon Sep 17 00:00:00 2001 From: sslinky Date: Wed, 29 May 2024 21:05:46 +0800 Subject: [PATCH 21/61] 1.3.5 --- package-lock.json | 4 ++-- package.json | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package-lock.json b/package-lock.json index ad561d1..b3326fe 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "vba-lsp", - "version": "1.3.4", + "version": "1.3.5", "lockfileVersion": 2, "requires": true, "packages": { "": { "name": "vba-lsp", - "version": "1.3.4", + "version": "1.3.5", "hasInstallScript": true, "license": "MIT", "devDependencies": { diff --git a/package.json b/package.json index b38531c..cfe420f 100644 --- a/package.json +++ b/package.json @@ -5,7 +5,7 @@ "icon": "images/vba-lsp-icon.png", "author": "SSlinky", "license": "MIT", - "version": "1.3.4", + "version": "1.3.5", "repository": { "type": "git", "url": "https://github.com/SSlinky/VBA-LanguageServer" From 8a8d068a1cc98f2cba04a2deae6b2c704f6c6d28 Mon Sep 17 00:00:00 2001 From: sslinky Date: Fri, 31 May 2024 14:00:53 +0800 Subject: [PATCH 22/61] Enable chaining --- server/src/project/document.ts | 1 + server/src/project/parser/vbaSyntaxParser.ts | 1 + 2 files changed, 2 insertions(+) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index 6d34679..76a786f 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -112,6 +112,7 @@ export abstract class BaseProjectDocument { registerDiagnosticElement(element: HasDiagnosticCapability) { this._hasDiagnosticElements.push(element); + return this; } /** diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index e4718a4..e4a8691 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -141,6 +141,7 @@ class VbaTreeWalkListener implements vbaListener { enterModule = (ctx: ModuleContext) => { const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); this.document.registerAttributeElement(element) + .registerDiagnosticElement(element) .registerScopedElement(element); }; From de2820dd1fd2eb3db27322187f60dfd9124eacbf Mon Sep 17 00:00:00 2001 From: sslinky Date: Fri, 31 May 2024 14:01:34 +0800 Subject: [PATCH 23/61] Missing Option Explicit diagnostic --- server/src/capabilities/diagnostics.ts | 8 +++++ server/src/project/elements/module.ts | 42 +++++++++++++++++++++++--- 2 files changed, 46 insertions(+), 4 deletions(-) diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 270a17e..8b9cc94 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -35,4 +35,12 @@ export class WhileWendDeprecatedDiagnostic extends BaseDiagnostic { constructor(range: Range) { super(range); } +} + +export class MissingOptionExplicitDiagnostic extends BaseDiagnostic { + message = "Option Explicit is missing from module header."; + severity = DiagnosticSeverity.Warning; + constructor(range: Range) { + super(range); + } } \ No newline at end of file diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index ae50968..ae725d9 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -1,15 +1,17 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; -import { SymbolInformation, SymbolKind } from 'vscode-languageserver'; -import { AttributeStmtContext, ModuleContext } from '../../antlr/out/vbaParser'; +import { Diagnostic, SymbolInformation, SymbolKind } from 'vscode-languageserver'; +import { AttributeStmtContext, ModuleContext, ModuleHeaderContext, ModuleOptionContext } from '../../antlr/out/vbaParser'; -import { BaseContextSyntaxElement, HasAttribute, HasSymbolInformation } from './base'; +import { BaseContextSyntaxElement, HasAttribute, HasDiagnosticCapability, HasSymbolInformation } from './base'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; +import { MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; -export class ModuleElement extends BaseContextSyntaxElement implements HasSymbolInformation, HasAttribute { +export class ModuleElement extends BaseContextSyntaxElement implements HasSymbolInformation, HasAttribute, HasDiagnosticCapability { private _hasName = false; private _name: string; symbolKind: SymbolKind; + diagnostics: Diagnostic[] = []; constructor(context: ModuleContext, document: TextDocument, symbolKind: SymbolKind) { super(context, document); @@ -27,6 +29,32 @@ export class ModuleElement extends BaseContextSyntaxElement implements HasSymbol ); } + evaluateDiagnostics(): void { + const optionExplicitDiagnotic = this._getOptionExplicitDiagnostic(); + if (optionExplicitDiagnotic) { + this.diagnostics.push(optionExplicitDiagnotic); + } + } + + private _getOptionExplicitDiagnostic(): Diagnostic | undefined { + let optionExplicitFound = false; + const context = this.context as ModuleContext; + const declarations = context.moduleHeader().moduleDeclarations()?.moduleDeclarationsElement(); + + if (declarations) { + for (const declaration of declarations) { + if ((declaration.moduleOption()?.text ?? '') === 'Option Explicit') { + optionExplicitFound = true; + break; + } + } + } + + return optionExplicitFound ? undefined : new MissingOptionExplicitDiagnostic( + (new ModuelHeaderElement(context.moduleHeader(), this.document)).range + ); + } + processAttribute(context: AttributeStmtContext): void { if (this._hasName) { return; @@ -42,3 +70,9 @@ export class ModuleElement extends BaseContextSyntaxElement implements HasSymbol } } } + +class ModuelHeaderElement extends BaseContextSyntaxElement { + constructor(context: ModuleHeaderContext, document: TextDocument) { + super(context, document); + } +} \ No newline at end of file From e09841a3c66af84d8be6430130b848e7d7e5d395 Mon Sep 17 00:00:00 2001 From: sslinky Date: Fri, 31 May 2024 16:41:20 +0800 Subject: [PATCH 24/61] lineLabel now parses with space --- server/src/antlr/vba.g4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 685aef5..bf990cf 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -671,7 +671,7 @@ fieldLength: MULT WS? (INTEGERLITERAL | ambiguousIdentifier); letterrange: certainIdentifier (WS? MINUS WS? certainIdentifier)?; -lineLabel: ambiguousIdentifier ' :'; +lineLabel: ambiguousIdentifier WS? (':' | COLON); literal: HEXLITERAL From 737e61b44a6e66e6e500cdb94b572d17b9fccb45 Mon Sep 17 00:00:00 2001 From: sslinky Date: Fri, 31 May 2024 17:10:52 +0800 Subject: [PATCH 25/61] Merged stashed changes --- package-lock.json | 47 +- package.json | 8 +- server/src/antlr/vba.g4 | 3704 +++++++++++++----- server/src/project/parser/vbaSyntaxParser.ts | 318 +- 4 files changed, 2876 insertions(+), 1201 deletions(-) diff --git a/package-lock.json b/package-lock.json index b3326fe..7481252 100644 --- a/package-lock.json +++ b/package-lock.json @@ -14,8 +14,8 @@ "@types/node": "^16.11.7", "@typescript-eslint/eslint-plugin": "^5.30.0", "@typescript-eslint/parser": "^5.30.0", - "antlr4ts": "^0.5.0-alpha.4", - "antlr4ts-cli": "^0.5.0-alpha.4", + "antlr4ng": "^3.0.4", + "antlr4ng-cli": "^2.0.0", "eslint": "^8.13.0", "js-yaml": "^4.1.0", "mocha": "^9.2.1", @@ -446,20 +446,24 @@ "url": "https://github.com/chalk/ansi-styles?sponsor=1" } }, - "node_modules/antlr4ts": { - "version": "0.5.0-alpha.4", - "resolved": "https://registry.npmjs.org/antlr4ts/-/antlr4ts-0.5.0-alpha.4.tgz", - "integrity": "sha512-WPQDt1B74OfPv/IMS2ekXAKkTZIHl88uMetg6q3OTqgFxZ/dxDXI0EWLyZid/1Pe6hTftyg5N7gel5wNAGxXyQ==", + "node_modules/antlr4ng": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/antlr4ng/-/antlr4ng-3.0.4.tgz", + "integrity": "sha512-u1Ww6wVv9hq70E9AaYe5qW3ba8hvnjJdO3ZsKnb3iJWFV/medLEEhbyWwXCvvD2ef0ptdaiIUgmaazS/WE6uyQ==", "dev": true, - "license": "BSD-3-Clause" + "license": "BSD-3-Clause", + "peerDependencies": { + "antlr4ng-cli": "^2.0.0" + } }, - "node_modules/antlr4ts-cli": { - "version": "0.5.0-alpha.4", - "resolved": "https://registry.npmjs.org/antlr4ts-cli/-/antlr4ts-cli-0.5.0-alpha.4.tgz", - "integrity": "sha512-lVPVBTA2CVHRYILSKilL6Jd4hAumhSZZWA7UbQNQrmaSSj7dPmmYaN4bOmZG79cOy0lS00i4LY68JZZjZMWVrw==", + "node_modules/antlr4ng-cli": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/antlr4ng-cli/-/antlr4ng-cli-2.0.0.tgz", + "integrity": "sha512-oAt5OSSYhRQn1PgahtpAP4Vp3BApCoCqlzX7Q8ZUWWls4hX59ryYuu0t7Hwrnfk796OxP/vgIJaqxdltd/oEvQ==", "dev": true, + "license": "BSD-3-Clause", "bin": { - "antlr4ts": "antlr4ts" + "antlr4ng": "index.js" } }, "node_modules/anymatch": { @@ -2408,16 +2412,17 @@ "color-convert": "^2.0.1" } }, - "antlr4ts": { - "version": "0.5.0-alpha.4", - "resolved": "https://registry.npmjs.org/antlr4ts/-/antlr4ts-0.5.0-alpha.4.tgz", - "integrity": "sha512-WPQDt1B74OfPv/IMS2ekXAKkTZIHl88uMetg6q3OTqgFxZ/dxDXI0EWLyZid/1Pe6hTftyg5N7gel5wNAGxXyQ==", - "dev": true + "antlr4ng": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/antlr4ng/-/antlr4ng-3.0.4.tgz", + "integrity": "sha512-u1Ww6wVv9hq70E9AaYe5qW3ba8hvnjJdO3ZsKnb3iJWFV/medLEEhbyWwXCvvD2ef0ptdaiIUgmaazS/WE6uyQ==", + "dev": true, + "requires": {} }, - "antlr4ts-cli": { - "version": "0.5.0-alpha.4", - "resolved": "https://registry.npmjs.org/antlr4ts-cli/-/antlr4ts-cli-0.5.0-alpha.4.tgz", - "integrity": "sha512-lVPVBTA2CVHRYILSKilL6Jd4hAumhSZZWA7UbQNQrmaSSj7dPmmYaN4bOmZG79cOy0lS00i4LY68JZZjZMWVrw==", + "antlr4ng-cli": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/antlr4ng-cli/-/antlr4ng-cli-2.0.0.tgz", + "integrity": "sha512-oAt5OSSYhRQn1PgahtpAP4Vp3BApCoCqlzX7Q8ZUWWls4hX59ryYuu0t7Hwrnfk796OxP/vgIJaqxdltd/oEvQ==", "dev": true }, "anymatch": { diff --git a/package.json b/package.json index cfe420f..edd39d6 100644 --- a/package.json +++ b/package.json @@ -90,20 +90,18 @@ "postinstall": "cd client && npm install && cd ../server && npm install && cd ..", "test": "sh ./scripts/e2e.sh", "textMate": "npx js-yaml client/src/syntaxes/vba.tmLanguage.yaml > client/out/vba.tmLanguage.json", - "antlr4ts": "antlr4ts -visitor ./server/src/antlr/vba.g4 -o ./server/src/antlr/out/" + "antlr4ts": "antlr4ng -Dlanguage=TypeScript -visitor ./server/src/antlr/vba.g4 -o ./server/src/antlr/out/" }, "devDependencies": { "@types/mocha": "^9.1.0", "@types/node": "^16.11.7", "@typescript-eslint/eslint-plugin": "^5.30.0", "@typescript-eslint/parser": "^5.30.0", - "antlr4ts-cli": "^0.5.0-alpha.4", + "antlr4ng": "^3.0.4", + "antlr4ng-cli": "^2.0.0", "eslint": "^8.13.0", "js-yaml": "^4.1.0", "mocha": "^9.2.1", "typescript": "^4.7.2" - }, - "dependencies": { - "antlr4ts": "^0.5.0-alpha.4" } } diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index bf990cf..dfd1204 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -1,1156 +1,2720 @@ /* - * VBA grammar heavily based on the antlr grammars version by Ulrich Wolffgang. - https - * ://github.com/antlr/grammars-v4/blob/master/vba/vba.g4 +* Visual Basic 7.1 Grammar for ANTLR4 +* +* Derived from the Visual Basic 7.1 language reference +* https://msopenspecs.azureedge.net/files/MS-VBAL/%5bMS-VBAL%5d.pdf +*/ + +// $antlr-format alignTrailingComments true, columnLimit 150, minEmptyLines 1, maxEmptyLinesToKeep 1, reflowComments false, useTab false +// $antlr-format allowShortRulesOnASingleLine false, allowShortBlocksOnASingleLine true, alignSemicolons hanging, alignColons hanging + +grammar vba; + +options { + caseInsensitive = true; +} + +// Contexts not listed in the specification +// Everything until section 5.1 is typically machine generated code. +startRule + : module EOF + ; + +// Added form file entry +module + : endOfLineNoWs* ( + proceduralModule + | classFileHeader classModule + | formFileHeader classModule + ) endOfLine* WS? + ; + +classFileHeader + : classVersionIdentification classBeginBlock + ; + +classVersionIdentification + : VERSION WS FLOATLITERAL WS CLASS + ; + +classBeginBlock + : endOfLine+ BEGIN beginBlockConfigElement+ endOfLine+ END + ; + +beginBlockConfigElement + : endOfLine+ (OBJECT '.')? '_'? ambiguousIdentifier WS? EQ WS? (('-'? literalExpression) | FILEOFFSET) + | formBeginBlock + | beginPropertyBlock + ; + +// Form entries +formFileHeader + : formVersionIdentification (formObjectAssign)* formBeginBlock + ; + +formVersionIdentification + : VERSION WS FLOATLITERAL + ; +formObjectAssign + : endOfLine+ OBJECT WS? EQ WS? STRINGLITERAL (';' WS? STRINGLITERAL)? + ; +formBeginBlock + : endOfLine+ BEGIN WS (GUID | (ambiguousIdentifier '.' ambiguousIdentifier)) WS ambiguousIdentifier beginBlockConfigElement+ endOfLine+ END + ; +beginPropertyBlock + : endOfLine+ BEGINPROPERTY WS ambiguousIdentifier (WS GUID WS?)? beginBlockConfigElement+ endOfLine+ ENDPROPERTY + ; + +//--------------------------------------------------------------------------------------- +// 4.2 Modules +proceduralModule + : proceduralModuleHeader endOfLineNoWs* proceduralModuleBody + ; +classModule + : classModuleHeader endOfLine* classModuleBody + ; + +// Compare STRINGLITERAL to quoted-identifier +proceduralModuleHeader + : endOfLine* ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL + ; +classModuleHeader: (endOfLine+ classAttr)+ WS?; + +// VBA Library Projects are allowed to have GoobalNamespace and creatable as true. +classAttr + : ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL + | ATTRIBUTE WS? VB_GLOBALNAMESPACE WS? EQ WS? booleanLiteralIdentifier + | ATTRIBUTE WS? VB_CREATABLE WS? EQ WS? booleanLiteralIdentifier + | ATTRIBUTE WS? VB_PREDECLAREDID WS? EQ WS? booleanLiteralIdentifier + | ATTRIBUTE WS? VB_EXPOSED WS? EQ WS? booleanLiteralIdentifier + | ATTRIBUTE WS? VB_CUSTOMIZABLE WS? EQ WS? booleanLiteralIdentifier + ; +//--------------------------------------------------------------------------------------- +// 5.1 Module Body Structure +// Everything from here down is user generated code. +proceduralModuleBody: proceduralModuleDeclarationSection? endOfLine* proceduralModuleCode; +classModuleBody: classModuleDeclarationSection? classModuleCode; +unrestrictedName + : reservedIdentifier + | name + ; + +// Added markedFileNumber to fix a bug +name + : untypedName + | typedName + | markedFileNumber + ; +untypedName + : ambiguousIdentifier + | FOREIGN_NAME + ; + +//--------------------------------------------------------------------------------------- +// 5.2 Module Declaration Section Structure +proceduralModuleDeclarationSection + : (endOfLine+ proceduralModuleDeclarationElement)+ + | ((endOfLine+ proceduralModuleDirectiveElement)* endOfLine+ defDirective) (proceduralModuleDeclarationElement endOfLineNoWs)* + ; +classModuleDeclarationSection + : (classModuleDeclarationElement endOfLine+)+ + | ((classModuleDirectiveElement endOfLine+)* defDirective) (classModuleDeclarationElement endOfLine+)* + ; +proceduralModuleDirectiveElement + : commonOptionDirective + | optionPrivateDirective + | defDirective + ; +proceduralModuleDeclarationElement + : commonModuleDeclarationElement + | globalVariableDeclaration + | publicConstDeclaration + | publicExternalProcedureDeclaration + | globalEnumDeclaration + | commonOptionDirective + | optionPrivateDirective + ; +classModuleDirectiveElement + : commonOptionDirective + | defDirective + | implementsDirective + ; +classModuleDeclarationElement + : commonModuleDeclarationElement + | eventDeclaration + | commonOptionDirective + | implementsDirective + ; + +// 5.2.1 Option Directives +commonOptionDirective + : optionCompareDirective + | optionBaseDirective + | optionExplicitDirective + | remStatement + ; + +// 5.2.1.1 Option Compare Directive +optionCompareDirective: OPTION wsc COMPARE wsc (BINARY | TEXT); + +// 5.2.1.2 Option Base Directive +// INTEGER or SHORT? +optionBaseDirective: OPTION wsc BASE wsc INTEGERLITERAL; + +// 5.2.1.3 Option Explicit Directive +optionExplicitDirective: OPTION wsc EXPLICIT; + +// 5.2.1.4 Option Private Directive +optionPrivateDirective: OPTION wsc PRIVATE wsc MODULE; + +// 5.2.2 Implicit Definition Directives +defDirective: defType WS letterSpec (WS ',' WS letterSpec)*; +letterSpec + : singleLetter + | universalLetterRange + | letterRange + ; +singleLetter: ambiguousIdentifier; +universalLetterRange: upperCaseA WS '-' WS upperCaseZ; +upperCaseA: ambiguousIdentifier; +upperCaseZ: ambiguousIdentifier; +letterRange: firstLetter WS '-' WS lastLetter; +firstLetter: ambiguousIdentifier; +lastLetter: ambiguousIdentifier; +defType + : DEFBOOL + | DEFBYTE + | DEFCUR + | DEFDATE + | DEFDBL + | DEFINT + | DEFINT + | DEFLNG + | DEFLNGLNG + | DEFLNGPTR + | DEFOBJ + | DEFSNG + | DEFSTR + | DEFVAR + ; + +// 5.2.3 Module Declarations +// added public-type to fix bug +commonModuleDeclarationElement + : moduleVariableDeclaration + | privateConstDeclaration + | privateTypeDeclaration + | publicTypeDeclaration + | privateEnumDeclaration + | publicEnumDeclaration + | privateExternalProcedureDeclaration + ; + +// 5.2.3.1 Module Variable Declaration Lists +// Added variableHelpAttribute, not in MS-VBAL +moduleVariableDeclaration + : publicVariableDecalation + | privateVariableDeclaration + | variableHelpAttribute + ; + +variableHelpAttribute + : ATTRIBUTE WS ambiguousIdentifier '.' VB_VARHELPID WS? '=' WS? '-'? INTEGERLITERAL + ; +globalVariableDeclaration: GLOBAL WS variableDeclarationList; +publicVariableDecalation: PUBLIC (WS SHARED)? WS moduleVariableDeclarationList; +privateVariableDeclaration: ((PRIVATE | DIM) wsc) (SHARED wsc)? moduleVariableDeclarationList; +moduleVariableDeclarationList: (witheventsVariableDcl | variableDcl) (wsc? ',' wsc? (witheventsVariableDcl | variableDcl))*; +variableDeclarationList: variableDcl (wsc? ',' wsc? variableDcl)*; + +// 5.2.3.1.1 Variable Declarations +variableDcl + : typedVariableDcl + | untypedVariableDcl + ; +typedVariableDcl: typedName wsc? arrayDim?; +untypedVariableDcl: ambiguousIdentifier wsc? (arrayClause | asClause)?; +arrayClause: arrayDim (wsc asClause)?; +asClause + : asAutoObject + | asType + ; + +// 5.2.3.1.2 WithEvents Variable Declarations +witheventsVariableDcl: WITHEVENTS wsc ambiguousIdentifier wsc AS wsc? classTypeName; +classTypeName: definedTypeExpression; + +// 5.2.3.1.3 Array Dimensions and Bounds +arrayDim: '(' wsc? boundsList? wsc? ')'; +boundsList: dimSpec (wsc? ',' wsc? dimSpec)*; +dimSpec: lowerBound? wsc? upperBound; +lowerBound: constantExpression wsc TO wsc; +upperBound: constantExpression; + +// 5.2.3.1.4 Variable Type Declarations +asAutoObject: AS WS NEW WS classTypeName; +asType: AS WS typeSpec; +typeSpec + : fixedLengthStringSpec + | typeExpression + ; +fixedLengthStringSpec: STRING WS '*' WS stringLength; +stringLength + : INTEGERLITERAL + | constantName + ; +constantName: simpleNameExpression; + +// 5.2.3.2 Const Declarations +publicConstDeclaration: (GLOBAL | PUBLIC) wsc moduleConstDeclaration; +privateConstDeclaration: (PRIVATE wsc)? moduleConstDeclaration; +moduleConstDeclaration: constDeclaration; +constDeclaration: CONST wsc constItemList; +constItemList: constItem (wsc? ',' wsc? constItem)*; +constItem + : typedNameConstItem + | untypedNameConstItem + ; +typedNameConstItem: typedName wsc? EQ wsc? constantExpression; +untypedNameConstItem: ambiguousIdentifier (wsc constAsClause)? wsc? EQ wsc? constantExpression; +constAsClause: AS wsc builtinType; + +// 5.2.3.3 User Defined Type Declarations +publicTypeDeclaration: ((GLOBAL | PUBLIC) wsc)? udtDeclaration; +privateTypeDeclaration: PRIVATE wsc udtDeclaration; +udtDeclaration: TYPE wsc untypedName endOfStatement+ udtMemberList endOfStatement+ END wsc TYPE; +udtMemberList: udtElement (endOfStatement udtElement)*; +udtElement + : remStatement + | udtMember + ; +udtMember + : reservedNameMemberDcl + | untypedNameMemberDcl + ; +untypedNameMemberDcl: ambiguousIdentifier optionalArrayClause; +reservedNameMemberDcl: reservedMemberName wsc asClause; +optionalArrayClause: arrayDim? wsc asClause; +reservedMemberName + : statementKeyword + | markerKeyword + | operatorIdentifier + | specialForm + | reservedName + | literalIdentifier + | reservedForImplementationUse + | futureReserved + ; + +// 5.2.3.4 Enum Declarations +globalEnumDeclaration: GLOBAL wsc enumDeclaration; +publicEnumDeclaration: (PUBLIC wsc)? enumDeclaration; +privateEnumDeclaration: PRIVATE wsc enumDeclaration; +enumDeclaration: ENUM wsc untypedName endOfStatement+ enumMemberList endOfStatement+ END wsc ENUM ; +enumMemberList: enumElement (endOfStatement enumElement)*; +enumElement + : remStatement + | enumMember + ; +enumMember: untypedName (wsc? EQ wsc? constantExpression)?; + +// 5.2.3.5 External Procedure Declaration +publicExternalProcedureDeclaration: (PUBLIC wsc)? externalProcDcl; +privateExternalProcedureDeclaration: PRIVATE wsc externalProcDcl; +externalProcDcl: DECLARE wsc (PTRSAFE wsc)? (externalSub | externalFunction); +externalSub: SUB wsc subroutineName wsc libInfo (wsc procedureParameters)?; +externalFunction: FUNCTION wsc functionName wsc libInfo (wsc procedureParameters)? (wsc functionType)?; +libInfo: libClause (wsc aliasClause)?; +libClause: LIB wsc STRINGLITERAL; +aliasClause: ALIAS wsc STRINGLITERAL; + +// 5.2.4 Class Module Declarations +// 5.2.4.2 Implements Directive +implementsDirective: IMPLEMENTS WS classTypeName; + +// 5.2.4.3 Event Declaration +eventDeclaration: PUBLIC? wsc EVENT wsc ambiguousIdentifier eventParameterList?; +eventParameterList: '(' wsc? positionalParameters? wsc? ')'; + + +//--------------------------------------------------------------------------------------- +// 5.3 Module Code Section Structure +// removed an EOS +proceduralModuleCode: (proceduralModuleCodeElement endOfLine*)*; +classModuleCode: (classModuleCodeElement endOfLine*)*; +proceduralModuleCodeElement: commonModuleCodeElement; +classModuleCodeElement + : commonModuleCodeElement + | implementsDirective + ; + +// Added AttributeStatement. +commonModuleCodeElement + : remStatement + | procedureDeclaration + | attributeStatement + ; +procedureDeclaration + : subroutineDeclaration + | functionDeclaration + | propertyGetDeclaration + | propertyLhsDeclaration + ; + +// 5.3.1 Procedure Declarations +// Allow a static keyword before or after, but not both +subroutineDeclaration + : (procedureScope wsc)? ( + ((initialStatic wsc)? SUB wsc subroutineName (wsc? procedureParameters?)) + | (SUB wsc subroutineName (wsc? procedureParameters)? wsc? trailingStatic) + ) + procedureBody? + endLabel? endOfStatement+ END wsc SUB procedureTail?; +functionDeclaration + : (procedureScope wsc)? ( + (initialStatic wsc)? FUNCTION wsc functionName (wsc? procedureParameters)? (wsc? functionType)? + | FUNCTION wsc functionName (wsc? procedureParameters)? (wsc? functionType)? wsc? trailingStatic) + procedureBody? + endLabel? endOfStatement+ END wsc FUNCTION procedureTail?; + +propertyGetDeclaration + : (procedureScope wsc)? ( + (initialStatic wsc)? PROPERTY wsc GET wsc functionName (wsc? procedureParameters)? (wsc? functionType)? + | PROPERTY wsc GET wsc functionName procedureParameters? (wsc? functionType)? wsc? trailingStatic) + procedureBody? + endLabel? endOfStatement+ END wsc PROPERTY procedureTail?; + +propertyLhsDeclaration + : (procedureScope wsc)? ( + (initialStatic wsc)? PROPERTY wsc (LET | SET) wsc subroutineName wsc? propertyParameters + | PROPERTY wsc (LET | SET) wsc subroutineName propertyParameters wsc? trailingStatic) + procedureBody? + endLabel? endOfStatement+ END wsc PROPERTY procedureTail?; +endLabel: endOfStatement* endOfLineNoWs statementLabelDefinition; +procedureTail + : wsc? NEWLINE + | wsc? commentBody + | WS? ':' WS? remStatement + ; + +// 5.3.1.1 Procedure Scope +procedureScope + : PRIVATE + | PUBLIC + | FRIEND + | GLOBAL + ; + +// 5.3.1.2 Static Procedures +initialStatic: STATIC; +trailingStatic: STATIC; + +// 5.3.1.3 Procedure Names +subroutineName + : ambiguousIdentifier + | prefixedName + ; +functionName + : typedName + | ambiguousIdentifier + | prefixedName + ; +prefixedName + : eventHandlerName + | implementedName + | lifecycleHandlerName + ; + +// 5.3.1.4 Function Type Declarations +functionType: AS wsc typeExpression wsc? arrayDesignator?; +arrayDesignator: '(' wsc? ')'; + +// 5.3.1.5 Parameter Lists +procedureParameters: '(' wsc? parameterList? wsc? ')'; +propertyParameters: '(' wsc? (parameterList wsc? ',' wsc?)? valueParam wsc? ')'; +parameterList + : (positionalParameters wsc? ',' wsc? optionalParameters) + | (positionalParameters (wsc? ',' wsc? paramArray)?) + | optionalParameters + | paramArray + ; + +positionalParameters: positionalParam (wsc? ',' wsc? positionalParam)*; +optionalParameters: optionalParam (wsc? ',' wsc? optionalParam)*; +valueParam: positionalParam; +positionalParam: (parameterMechanism wsc)? paramDcl; +optionalParam + : optionalPrefix wsc paramDcl wsc? defaultValue?; +paramArray + : PARAMARRAY wsc ambiguousIdentifier '(' wsc? ')' (wsc AS wsc (VARIANT | '[' VARIANT ']'))?; +paramDcl + : untypedNameParamDcl + | typedNameParamDcl + ; +untypedNameParamDcl: ambiguousIdentifier parameterType?; +typedNameParamDcl: typedName arrayDesignator?; +optionalPrefix + : OPTIONAL (wsc parameterMechanism)? + | parameterMechanism wsc OPTIONAL + ; +parameterMechanism + : BYVAL + | BYREF + ; +parameterType: arrayDesignator? wsc AS wsc (typeExpression | ANY); +defaultValue: '=' wsc? constantExpression; + +// 5.3.1.8 Event Handler Declarations +eventHandlerName: ambiguousIdentifier; + +// 5.3.1.9 Implemented Name Declarations +implementedName: ambiguousIdentifier; + +// 5.3.1.10 Lifecycle Handler Declarations +lifecycleHandlerName + : CLASS_INITIALIZE + | CLASS_TERMINATE + ; + +//--------------------------------------------------------------------------------------- +// 5.4 Procedure Bodies and Statements +procedureBody: statementBlock; + +// 5.4.1 Statement Blocks +// spec used *, changed to + changed all parent to call with ? to avoid empty context. +// Made EOS optional to be able to force EOL before ifStatement elements. +statementBlock + : blockStatement+ + ; +blockStatement + : endOfStatement* endOfLineNoWs statementLabelDefinition + | endOfStatement+ remStatement + | statement + | endOfStatement* endOfLineNoWs attributeStatement + ; +statement + : controlStatement + | endOfStatement+ dataManipulationStatement + | endOfStatement+ errorHandlingStatement + | endOfStatement+ fileStatement + ; + +// 5.4.1.1 Statement Labels +statementLabelDefinition + : identifierStatementLabel ':' + | lineNumberLabel ':'? + ; +statementLabel + : identifierStatementLabel + | lineNumberLabel + ; +statementLabelList: statementLabel (wsc? ',' wsc? statementLabel)?; +identifierStatementLabel: ambiguousIdentifier; +lineNumberLabel: INTEGERLITERAL; + +// 5.4.1.2 Rem Statement +// We have a token for this +remStatement: REMCOMMENT; + +// 5.4.2 Control Statements +controlStatement + : endOfStatement* endOfLine+ ifStatement + | endOfStatement+ controlStatementExceptMultilineIf + ; +controlStatementExceptMultilineIf + : callStatement + | whileStatement + | forStatement + | exitForStatement + | doStatement + | exitDoStatement + | singleLineIfStatement + | selectCaseStatement + | stopStatement + | gotoStatement + | onGotoStatement + | gosubStatement + | returnStatement + | onGosubStatement + | forEachStatement + | exitSubStatement + | exitFunctionStatement + | exitPropertyStatement + | raiseeventStatement + | withStatement + | endStatement + | debugStatement + ; + +// 5.4.2.1 Call Statement +callStatement + : CALL wsc (simpleNameExpression + | memberAccessExpression + | indexExpression + | withExpression) + | (simpleNameExpression + | memberAccessExpression + | withExpression) (wsc argumentList)? + ; + +// 5.4.2.2 While Statement +whileStatement + : WHILE wsc booleanExpression + statementBlock? endOfStatement+ WEND; + +// 5.4.2.3 For Statement +forStatement + : simpleForStatement + | explicitForStatement + ; +simpleForStatement: forClause statementBlock? endOfStatement+ NEXT; +explicitForStatement + : forClause statementBlock? endOfStatement+ (NEXT | (nestedForStatement wsc? ',')) wsc boundVariableExpression; +nestedForStatement + : explicitForStatement + | explicitForEachStatement + ; +forClause + : FOR wsc boundVariableExpression wsc? EQ wsc? startValue wsc TO wsc endValue (wsc stepClause)?; +startValue: expression; +endValue: expression; +stepClause: STEP wsc stepIncrement; +stepIncrement: expression; + +// 5.4.2.4 For Each Statement +forEachStatement + : simpleForEachStatement + | explicitForEachStatement + ; +simpleForEachStatement + : forEachClause statementBlock? endOfStatement+ NEXT; + +explicitForEachStatement + : forEachClause statementBlock? + endOfStatement (NEXT | (nestedForStatement wsc? ',')) wsc boundVariableExpression; + forEachClause: FOR wsc EACH wsc? boundVariableExpression wsc? IN wsc? collection; + collection: expression; + +// 5.4.2.5 Exit For Statement +exitForStatement: EXIT wsc FOR; + +// 5.4.2.6 Do Statement +doStatement + : DO (wsc? conditionClause)? statementBlock? endOfStatement+ + LOOP (wsc? conditionClause)?; +conditionClause + : whileClause + | untilClause + ; +whileClause: WHILE wsc? booleanExpression; +untilClause: UNTIL wsc? booleanExpression; + +// 5.4.2.7 Exit Do Statement +exitDoStatement: EXIT wsc DO; + +// 5.4.2.8 If Statement +// why is a LINE-START required before this? +ifStatement + : IF wsc? booleanExpression wsc? THEN + statementBlock? + elseIfBlock* + elseBlock? endOfStatement+ + ((END wsc IF) | ENDIF); +// Need to verify why some of the end-of-line / line-start things are set the way they are. +elseIfBlock + : endOfStatement* endOfLine ELSEIF wsc? booleanExpression wsc? THEN endOfLine? + statementBlock? + | endOfStatement* ELSEIF wsc? booleanExpression wsc? THEN statementBlock? + ; +elseBlock: endOfLine+ ELSE endOfLine? wsc? statementBlock?; + +// 5.4.2.9 Single-line If Statement +singleLineIfStatement + : ifWithNonEmptyThen + | ifWithEmptyThen + ; +ifWithNonEmptyThen + : IF wsc booleanExpression wsc THEN wsc? listOrLabel (wsc singleLineElseClause)?; +ifWithEmptyThen + : IF wsc booleanExpression wsc THEN wsc singleLineElseClause; +singleLineElseClause: ELSE wsc? listOrLabel?; +listOrLabel + : (statementLabel (':' wsc? sameLineStatement?)*) + | ':'? wsc? sameLineStatement (wsc? ':' wsc? sameLineStatement?)* + ; +sameLineStatement + : fileStatement + | errorHandlingStatement + | dataManipulationStatement + | controlStatementExceptMultilineIf + ; + +// 5.4.2.10 Select Case Statement +selectCaseStatement + : SELECT wsc CASE wsc selectExpression + caseClause* + caseElseClause? + endOfStatement+ END wsc SELECT; +caseClause: endOfStatement+ CASE wsc? rangeClause (wsc? ',' wsc? rangeClause)* statementBlock?; +caseElseClause: endOfStatement+ CASE wsc ELSE statementBlock?; +rangeClause + : expression + | startValue wsc? TO wsc? endValue + | IS? wsc comparisonOperator wsc? expression; +selectExpression: expression; +comparisonOperator + : EQ + | NEW + | LT + | GT + | LEQ + | GEQ + ; + +// 5.4.2.11 Stop Statement +stopStatement: STOP; + +// 5.4.2.12 GoTo Statement +gotoStatement: (GO wsc TO | GOTO) wsc statementLabel; + +// 5.4.2.13 On…GoTo Statement +onGotoStatement: ON wsc? expression GOTO wsc statementLabelList; + +// 5.4.2.14 GoSub Statement +gosubStatement: ((GO wsc SUB) | GOSUB) wsc statementLabel; + +// 5.4.2.15 Return Statement +returnStatement: RETURN; + +// 5.4.2.16 On…GoSub Statement +onGosubStatement: ON wsc? expression wsc? GOSUB wsc statementLabelList; + +// 5.4.2.17 Exit Sub Statement +exitSubStatement: EXIT wsc SUB; + +// 5.4.2.18 Exit Function Statement +exitFunctionStatement: EXIT wsc FUNCTION; + +// 5.4.2.19 Exit Property Statement +exitPropertyStatement: EXIT wsc PROPERTY; + +// 5.4.2.20 RaiseEvent Statement +raiseeventStatement + : RAISEEVENT wsc? ambiguousIdentifier wsc? ('(' wsc? eventArgumentList wsc? ')')?; +eventArgumentList: (eventArgument (wsc? ',' wsc? eventArgument)*)?; +eventArgument: expression; + +// 5.4.2.21 With Statement +withStatement: WITH wsc? expression statementBlock? endOfStatement+ END wsc WITH; + +// Missing from documentation +endStatement + : END + ; + +// 5.4.3 Data Manipulation Statements +// Added eraseStatement. It is missing from the list in MsS-VBAL 1.7 +dataManipulationStatement + : localVariableDeclaration + | staticVariableDeclaration + | localConstDeclaration + | redimStatement + | eraseStatement + | midStatement + | rsetStatement + | lsetStatement + | letStatement + | setStatement + ; + +// 5.4.3.1 Local Variable Declarations +localVariableDeclaration: DIM wsc? SHARED? wsc? variableDeclarationList; +staticVariableDeclaration: STATIC wsc variableDeclarationList; + +// 5.4.3.2 Local Constant Declarations +localConstDeclaration: constDeclaration; + +// 5.4.3.3 ReDim Statement +redimStatement: REDIM (wsc PRESERVE)? wsc? redimDeclarationList; +redimDeclarationList: redimVariableDcl (wsc? ',' wsc? redimVariableDcl)*; +// Had to add withExpression and memberAccess +// to match callStatement. +redimVariableDcl + : redimTypedVariableDcl + | redimUntypedDcl + | withExpressionDcl + | memberAccessExpressionDcl + ; +redimTypedVariableDcl: typedName wsc? dynamicArrayDim; +redimUntypedDcl: untypedName wsc? dynamicArrayClause; +withExpressionDcl: withExpression wsc? dynamicArrayDim; +memberAccessExpressionDcl: memberAccessExpression wsc? dynamicArrayDim; +dynamicArrayDim: '(' wsc? dynamicBoundsList wsc? ')'; +dynamicBoundsList: dynamicDimSpec (wsc? ',' wsc? dynamicDimSpec)*; +dynamicDimSpec: (dynamicLowerBound wsc)? dynamicUpperBound; +dynamicLowerBound: integerExpression wsc? TO; +dynamicUpperBound: integerExpression; +dynamicArrayClause: dynamicArrayDim wsc? asClause?; + +// 5.4.3.4 Erase Statement +eraseStatement: ERASE wsc? eraseList; +eraseList: eraseElement (wsc? ',' wsc? eraseElement)*; +eraseElement: lExpression; + +// 5.4.3.5 Mid/MidB/Mid$/MidB$ Statement +midStatement: modeSpecifier wsc? '(' wsc? stringArgument wsc? ',' wsc? startMid wsc? (',' wsc? length)? ')' wsc? EQ wsc? expression; +modeSpecifier + : MID + | MIDB + | MID_D + | MIDB_D + ; +stringArgument: boundVariableExpression; +// Changed name from start to startMid due to a problem with the Dart compilation. +startMid: integerExpression; +length: integerExpression; + +// 5.4.3.6 LSet Statement +lsetStatement: LSET wsc? boundVariableExpression wsc? EQ wsc? expression; + +// 5.4.3.7 RSet Statement +rsetStatement: RSET wsc? boundVariableExpression wsc? EQ wsc? expression; + +// 5.4.3.8 Let Statement +letStatement: (LET wsc)? lExpression wsc? EQ wsc? expression; + +// 5.4.3.9 Set Statement +setStatement: SET wsc lExpression wsc? EQ wsc? expression; + +// 5.4.4 Error Handling Statements +errorHandlingStatement + : onErrorStatement + | resumeStatement + | errorStatement + ; + +// 5.4.4.1 On Error Statement +onErrorStatement: ON wsc ERROR wsc? errorBehavior; +errorBehavior + : RESUME wsc NEXT + | GOTO wsc? statementLabel + ; + +// 5.4.4.2 Resume Statement +resumeStatement: RESUME wsc? (NEXT| statementLabel)?; + +// 5.4.4.3 Error Statement +errorStatement: ERROR wsc errorNumber; +errorNumber: integerExpression; + +// 5.4.5 File Statements +fileStatement + : openStatement + | closeStatement + | seekStatement + | lockStatement + | unlockStatement + | lineInputStatement + | widthStatement + | printStatement + | writeStatement + | inputStatement + | putStatement + | getStatement + ; + +// 5.4.5.1 Open Statement +openStatement + : OPEN wsc? pathName wsc? modeClause? wsc accessClause? wsc? lock? wsc? AS wsc? fileNumber wsc? lenClause? + ; +pathName: expression; +modeClause: FOR wsc modeOpt; +modeOpt + : APPEND + | BINARY + | INPUT + | OUTPUT + | RANDOM + ; +accessClause: ACCESS wsc access; +access + : READ + | WRITE + | READ wsc WRITE + ; +lock + : SHARED + | LOCK wsc READ + | LOCK wsc WRITE + | LOCK wsc READ wsc WRITE + ; +lenClause: LEN wsc EQ wsc recLength; +recLength: expression; + +// 5.4.5.1.1 File Numbers +fileNumber + : markedFileNumber + | unmarkedFileNumber + ; +markedFileNumber: '#' expression; +unmarkedFileNumber: expression; + +// 5.4.5.2 Close and Reset Statements +closeStatement + : RESET + | CLOSE wsc? fileNumberList? + ; +fileNumberList: fileNumber (wsc? ',' wsc? fileNumber)*; + +// 5.4.5.3 Seek Statement +seekStatement: SEEK wsc fileNumber wsc? ',' wsc? position; +position: expression; + +// 5.4.5.4 Lock Statement +lockStatement: LOCK wsc fileNumber (wsc? ',' wsc? recordRange); +recordRange + : startRecordNumber + | startRecordNumber? wsc TO wsc endRecordNumber + ; +startRecordNumber: expression; +endRecordNumber: expression; + +// 5.4.5.5 Unlock Statement +unlockStatement: UNLOCK wsc fileNumber (wsc? ',' wsc? recordRange)?; + +// 5.4.5.6 Line Input Statement +lineInputStatement: LINE wsc INPUT wsc markedFileNumber wsc? ',' wsc? variableName; +variableName: variableExpression; + +// 5.4.5.7 Width Statement +widthStatement: WIDTH wsc markedFileNumber wsc? ',' wsc? lineWidth; +lineWidth: expression; + +// 5.4.5.8 Print Statement +printStatement: PRINT wsc markedFileNumber wsc? ',' wsc? outputList?; + +// 5.4.5.8.1 Output Lists +outputList: outputItem+; +outputItem + : outputClause charPosition? + | charPosition; +outputClause: spcClause | tabClause| outputExpression; +charPosition: ';' | ','; +outputExpression: expression; +spcClause: SPC wsc '(' wsc? spcNumber wsc? ')'; +spcNumber: expression; +tabClause: TAB wsc '(' wsc? tabNumber wsc? ')'; +tabNumber: expression; + +// 5.4.5.9 Write Statement +writeStatement: WRITE wsc markedFileNumber wsc? ',' wsc? outputList?; + +// 5.4.5.10 Input Statement +inputStatement: INPUT wsc markedFileNumber wsc? ',' wsc? inputList; +inputList: inputVariable (wsc? ',' wsc? inputVariable)*; +inputVariable: boundVariableExpression; + +// 5.4.5.11 Put Statement +putStatement: PUT wsc fileNumber wsc? ',' wsc? recordNumber? wsc? ',' wsc? data; +recordNumber: expression; +data: expression; + +// 5.4.5.12 Get Statement +getStatement: GET wsc fileNumber wsc? ',' wsc? recordNumber? wsc? ',' wsc? variable; +variable: variableExpression; + +// Attribute Statement +attributeStatement + : ATTRIBUTE WS ambiguousIdentifier '.' attributeDescName WS? EQ WS? STRINGLITERAL + | ATTRIBUTE WS ambiguousIdentifier '.' attributeUsrName WS? EQ WS? '-'? INTEGERLITERAL + | ATTRIBUTE WS ambiguousIdentifier '.' VB_PROCDATA '.' VB_INVOKE_FUNC WS EQ WS STRINGLITERAL + ; + +attributeDescName + : VB_DESCRIPTION + | VB_VARDESCRIPTION + | VB_MEMBERFLAGS + | VB_VARMEMBERFLAGS + ; + +attributeUsrName + : 'VB_USERMEMID' + | 'VB_VARUSERMEMID' + ; + +// Added Statement +debugStatement + : DEBUG '.' PRINT wsc debugArgs + ; +debugArgs + : expression (wsc? debugSep wsc? expression)* + ; +debugSep + : wsc + | ';' + | ',' + ; + +//--------------------------------------------------------------------------------------- +// 5.6 Expressions +// Modifying the order will affect the order of operations +// valueExpression must be rolled up into expression due to mutual left recursion +// operatorExpression must be rolled up into expression due to mutual left recursion +// memberAccess +// DictionaryAccess +expression + : literalExpression + | parenthesizedExpression + | typeofIsExpression + | newExpress + | expression wsc? POW wsc? expression + | unaryMinusExpression + | expression wsc? (DIV | MULT) wsc? expression + | expression wsc? MOD wsc? expression + | expression wsc? (PLUS | MINUS) wsc? expression + | expression wsc? AMPERSAND wsc? expression + | expression wsc? (IS | LIKE | GEQ | LEQ | GT | LT | NEQ | EQ) wsc? expression + | notOperatorExpression + | expression wsc? (AND | OR | XOR | EQV | IMP) wsc? expression + | lExpression + ; + +// Several of the lExpression rules are rolled up due to Mutual Left Recursion +// Many are also listed separately due to their specific use elsewhere. +lExpression + : simpleNameExpression + | instanceExpression +// memberAccessExpression + | lExpression '.' wsc? unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc?'.' wsc? unrestrictedName +// indexExpression + | lExpression wsc? '(' wsc? argumentList wsc? ')' +// dictionaryAccessExpression + | lExpression '!' unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc? '!' unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc? '!' wsc? LINE_CONTINUATION wsc? unrestrictedName + | withExpression + ; + +// 5.6.5 Literal Expressions +// check on hex and oct +// check definition of integer and float +literalExpression + : DATELITERAL + | FLOATLITERAL + | INTEGERLITERAL + | STRINGLITERAL + | literalIdentifier typeSuffix? + ; + +// 5.6.6 Parenthesized Expressions +parenthesizedExpression: LPAREN wsc? expression wsc? RPAREN; + +// 5.6.7 TypeOf…Is Expressions +typeofIsExpression: TYPEOF wsc? expression wsc? IS wsc? typeExpression; + +// 5.6.8 New Expressions +// The name 'newExpression' fails under the Go language +newExpress + : NEW wsc? expression + ; + +// 5.6.9.8.1 Not Operator +notOperatorExpression: NOT wsc? expression; + +// 5.6.9.3.1 Unary - Operator +unaryMinusExpression: MINUS wsc? expression; + +// 5.6.10 Simple Name Expressions +// Had to add reservedName and specialForm to allow calls to Abs() Debug. and Lbound() +simpleNameExpression + : name + | reservedName + | specialForm +; + +// 5.6.11 Instance Expressions +instanceExpression: ME; + +// 5.6.12 Member Access Expressions +// This expression is also rolled into lExpression. +// Changes here must be duplicated there +memberAccessExpression + : lExpression '.' wsc? unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc?'.' wsc? unrestrictedName + ; + +// 5.6.13 Index Expressions +// This expression is also rolled into lExpression. +// Changes here must be duplicated there +indexExpression + : lExpression wsc? '(' wsc? argumentList wsc? ')' + ; + +// 5.6.13.1 Argument Lists +argumentList: positionalOrNamedArgumentList?; +positionalOrNamedArgumentList + : (positionalArgument wsc? ',' wsc?)* requiredPositionalArgument + | (positionalArgument wsc? ',' wsc?)* namedArgumentList + ; +positionalArgument: argumentExpression?; +requiredPositionalArgument: argumentExpression; +namedArgumentList: namedArgument (wsc? ',' wsc? namedArgument)*; +namedArgument: unrestrictedName wsc? ASSIGN wsc? argumentExpression; +argumentExpression + : (BYVAL wsc)? expression + | addressofExpression + ; + +// 5.6.14 Dictionary Access Expressions +// This expression is also rolled into lExpression. +// Changes here must be duplicated there +dictionaryAccessExpression + : lExpression '!' unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc? '!' unrestrictedName + | lExpression wsc? LINE_CONTINUATION wsc? '!' wsc? LINE_CONTINUATION wsc? unrestrictedName + ; + +// 5.6.15 With Expressions +withExpression + : withMemberAccessExpression + | withDictionaryAccessExpression + ; +withMemberAccessExpression: '.' unrestrictedName; +withDictionaryAccessExpression: '!' unrestrictedName; + +// 5.6.16 Constrained Expressions +// The following Expressions have complex static requirements + +// 5.6.16.1 Constant Expressions +constantExpression: expression; + +// 5.6.16.2 Conditional Compilation Expressions +ccExpression: expression; + +// 5.6.16.3 Boolean Expressions +booleanExpression: expression; + +// 5.6.16.4 Integer Expressions +integerExpression: expression; + +// 5.6.16.5 +variableExpression: lExpression; + +// 5.6.16.6 +boundVariableExpression: lExpression; + +// 5.6.16.7 +typeExpression + : builtinType + | definedTypeExpression + ; +definedTypeExpression + : simpleNameExpression + | memberAccessExpression + ; + +// 5.6.16.8 +addressofExpression + : ADDRESSOF wsc procedurePointerExpression + ; +procedurePointerExpression + : simpleNameExpression + | memberAccessExpression + ; + +//--------------------------------------------------------------------------------------- +// Many of the following are labeled as tokens in the standard, but are parser rules here. +// 3.3.1 Separator and Special Tokens +// In theory whitespace should be ignored, but there are a handful of cases +// where statements MUST be at the beginning of a line or where a NO-WS +// rule appears in the parser rule. +// If may make things simpler here to send all wsc to the hidden channel +// and let a linting tool highlight the couple cases where whitespace +// will cause an error. +wsc: (WS | LINE_CONTINUATION)+; +// known as EOL in MS-VBAL +endOfLine + : wsc? (NEWLINE | commentBody | remStatement) wsc? + ; +// We usually don't care if a line of code begins with whitespace, and the parser rules are +// cleaner if we lump that in with the EOL or EOS "token". However, for those cases where +// something MUST occur on the start of a line, use endOfLineNoWs. +endOfLineNoWs + : wsc? (NEWLINE | commentBody | remStatement) + ; +// known as EOS in MS-VBAL +endOfStatement + : (endOfLine | wsc? COLON wsc?)+ + ; +endOfStatementNoWs + : (endOfLineNoWs | wsc? COLON)+ + ; +// The COMMENT token includes the leading single quote +commentBody: COMMENT; + +// 3.3.5.2 Reserved Identifiers and IDENTIFIER +reservedIdentifier + : statementKeyword + | markerKeyword + | operatorIdentifier + | specialForm + | reservedName + | reservedTypeIdentifier + | literalIdentifier + | remKeyword + | reservedForImplementationUse + | futureReserved + ; +// Known as IDENTIFIER in MS-VBAL +ambiguousIdentifier + : IDENTIFIER + | ambiguousKeyword + ; +statementKeyword + : CALL + | CASE + | CLOSE + | CONST + | DECLARE + | DEFBOOL + | DEFBYTE + | DEFCUR + | DEFDATE + | DEFDBL + | DEFINT + | DEFLNG + | DEFLNGLNG + | DEFLNGPTR + | DEFOBJ + | DEFSNG + | DEFSTR + | DEFVAR + | DIM + | DO + | ELSE + | ELSEIF + | END + | ENDIF + | ENUM + | ERASE + | EVENT + | EXIT + | FOR + | FRIEND + | FUNCTION + | GET + | GLOBAL + | GOSUB + | GOTO + | IF + | IMPLEMENTS + | INPUT + | LET + | LOCK + | LOOP + | LSET + | NEXT + | ON + | OPEN + | OPTION + | PRINT + | PRIVATE + | PUBLIC + | PUT + | RAISEEVENT + | REDIM + | RESUME + | RETURN + | RSET + | SEEK + | SELECT + | SET + | STATIC + | STOP + | SUB + | TYPE + | UNLOCK + | WEND + | WHILE + | WITH + | WRITE + ; +remKeyword: REM; +markerKeyword + : ANY + | AS + | BYREF + | BYVAL + | CASE + | EACH + | ELSE + | IN + | NEW + | SHARED + | UNTIL + | WITHEVENTS + | WRITE + | OPTIONAL + | PARAMARRAY + | PRESERVE + | SPC + | TAB + | THEN + | TO + ; +operatorIdentifier + : ADDRESSOF + | AND + | EQV + | IMP + | IS + | LIKE + | NEW + | MOD + | NOT + | OR + | TYPEOF + | XOR + ; +reservedName + : ABS + | CBOOL + | CBYTE + | CCUR + | CDATE + | CDBL + | CDEC + | CINT + | CLNG + | CLNGLNG + | CLNGPTR + | CSNG + | CSTR + | CVAR + | CVERR + | DATE + | DEBUG + | DOEVENTS + | FIX + | INT + | LEN + | LENB + | ME + | PSET + | SCALE + | SGN + | STRING + ; +specialForm + : ARRAY + | CIRCLE + | INPUT + | INPUTB + | LBOUND + | SCALE + | UBOUND + ; +reservedTypeIdentifier + : BOOLEAN + | BYTE + | CURRENCY + | DATE + | DOUBLE + | INTEGER + | LONG + | LONGLONG + | LONGPTR + | SINGLE + | STRING + | VARIANT + ; + +// If we did not scoop up the bracketed forms in the Lexer, they would have become +// Foreign Names. +reservedTypeIdentifierB + : BOOLEAN_B + | BYTE_B + | CURRENCY_B + | DATE_B + | DOUBLE_B + | INTEGER_B + | LONG_B + | LONGLONG_B + | LONGPTR_B + | SINGLE_B + | STRING_B + | VARIANT_B + ; + +typeableReservedName + : DATE + | STRING + ; +literalIdentifier + : booleanLiteralIdentifier + | objectLiteralIdentifier + | variantLiteralIdentifier + ; +booleanLiteralIdentifier + : TRUE + | FALSE + ; +objectLiteralIdentifier + : NOTHING + ; +variantLiteralIdentifier + : EMPTY_X + | NULL_ + ; +reservedForImplementationUse + : ATTRIBUTE + | LINEINPUT + | VB_BASE + | VB_CONTROL + | VB_CREATABLE + | VB_CUSTOMIZABLE + | VB_DESCRIPTION + | VB_EXPOSED + | VB_EXT_KEY + | VB_GLOBALNAMESPACE + | VB_HELPID + | VB_INVOKE_FUNC + | VB_INVOKE_PROPERTY + | VB_INVOKE_PROPERTYPUT + | VB_INVOKE_PROPERTYPUTREF + | VB_MEMBERFLAGS + | VB_NAME + | VB_PREDECLAREDID + | VB_PROCDATA + | VB_TEMPLATEDERIVED + | VB_USERMEMID + | VB_VARDESCRIPTION + | VB_VARHELPID + | VB_VARMEMBERFLAGS + | VB_VARPROCDATA + | VB_VARUSERMEMID + ; +futureReserved + : CDECL + | DECIMAL + | DEFDEC + ; + +// 3.3.5.3 Special Identifier Forms + +// known as BUILTIN-TYPE in MS-VBAL +builtinType + : reservedTypeIdentifier + | reservedTypeIdentifierB + | OBJECT + | OBJECT_B + ; + +// Known as TYPED-NAME in MS-VBAL +// This probably could be turned into a token +typedName + : ambiguousIdentifier typeSuffix + | typeableReservedName typeSuffix + ; +typeSuffix + : '&' + | '%' + | '#' + | '!' + | '@' + | '$' + | '^' + ; + +//--------------------------------------------------------------------------------------- +// Extra Rules + +// lexer keywords not in the reservedIdentifier set +// any that are unused within the parser rules should probably +// be removed from the lexer. +ambiguousKeyword + : ACCESS + | ALIAS + | APPACTIVATE + | APPEND + | BASE + | BEGIN + | BEGINPROPERTY + | BINARY + | CLASS + | CHDIR + | CHDRIVE + | CLASS_INITIALIZE + | CLASS_TERMINATE + | COLLECTION + | COMPARE + | DATABASE + | DELETESETTING + | ERROR + | ENDPROPERTY + | FILECOPY + | GO + | KILL + | LOAD + | LIB + | LINE + | MID + | MIDB + | MID_D + | MIDB_D + | MKDIR + | MODULE + | NAME + | OBJECT + | OUTPUT + | PROPERTY + | RANDOM + | RANDOMIZE + | READ + | RESET + | RMDIR + | SAVEPICTURE + | SAVESETTING + | SENDKEYS + | SETATTR + | STEP + | TEXT + | TIME + | UNLOAD + | VERSION + | WIDTH + ; + +// keywords +ABS + : 'ABS' + ; + +ACCESS + : 'ACCESS' + ; + +ADDRESSOF + : 'ADDRESSOF' + ; + +ALIAS + : 'ALIAS' + ; + +AND + : 'AND' + ; + +ANY + : 'ANY' + ; + +ATTRIBUTE + : 'ATTRIBUTE' + ; + +APPEND + : 'APPEND' + ; + +ARRAY + : 'ARRAY' + ; + +AS + : 'AS' + ; + +BASE + : 'BASE' + ; + +BEGIN + : 'BEGIN' + ; +BEGINPROPERTY + : 'BEGINPROPERTY' + ; + +BINARY + : 'BINARY' + ; + +BOOLEAN + : 'BOOLEAN' + ; + +BOOLEAN_B + : '[BOOLEAN]' + ; + +BYVAL + : 'BYVAL' + ; + +BYREF + : 'BYREF' + ; + +BYTE + : 'BYTE' + ; + +BYTE_B + : '[BYTE]' + ; + +CALL + : 'CALL' + ; + +CASE + : 'CASE' + ; + +CBOOL + : 'CBOOL' + ; + +CBYTE + : 'CBYTE' + ; + +CCUR + : 'CCUR' + ; + +CDATE + : 'CDATE' + ; + +CDBL + : 'CDBL' + ; + +CDEC + : 'CDEC' + ; + +CDECL + : 'CDECL' + ; + +CHDIR + : 'CHDIR' + ; + +CHDRIVE + : 'CHDRIVE' + ; + +CINT + : 'CINT' + ; + +CIRCLE + : 'CIRCLE' + ; + +CLASS + : 'CLASS' + ; + +CLASS_INITIALIZE + : 'CLASS_INITIALIZE' + ; + +CLASS_TERMINATE + : 'CLASS_TERMINATE' + ; + +CLNG + : 'CLNG' + ; + +CLNGLNG + : 'CLNGLNG' + ; + +CLNGPTR + : 'CLNGPTR' + ; + +CLOSE + : 'CLOSE' + ; + +COMPARE + : 'COMPARE' + ; + +CONST + : 'CONST' + ; + +CSNG + : 'CSNG' + ; + +CSTR + : 'CSTR' + ; + +CVAR + : 'CVAR' + ; + +CVERR + : 'CVERR' + ; + +CURRENCY + : 'CURRENCY' + ; + +CURRENCY_B + : '[CURRENCY]' + ; + +DATE + : 'DATE' + ; + +DATE_B + : '[DATE]' + ; + +DEBUG + : 'DEBUG' + ; + +DECLARE + : 'DECLARE' + ; + +DECIMAL + : 'DECIMAL' + ; + +DEFBOOL + : 'DEFBOOL' + ; + +DEFBYTE + : 'DEFBYTE' + ; + +DEFCUR + : 'DEFCUR' + ; + +DEFDATE + : 'DEFDATE' + ; + +DEFDBL + : 'DEFDBL' + ; + +DEFDEC + : 'DEFDEC' + ; + +DEFINT + : 'DEFINT' + ; + +DEFLNG + : 'DEFLNG' + ; + +DEFLNGLNG + : 'DEFLNGLNG' + ; + +DEFLNGPTR + : 'DEFLNGPTR' + ; + +DEFOBJ + : 'DEFOBJ' + ; + +DEFSNG + : 'DEFSNG' + ; + +DEFSTR + : 'DEFSTR' + ; + +DEFVAR + : 'DEFVAR' + ; + +DIM + : 'DIM' + ; + +DO + : 'DO' + ; + +DOEVENTS + : 'DOEVENTS' + ; + +DOUBLE + : 'DOUBLE' + ; + +DOUBLE_B + : '[DOUBLE]' + ; + +EACH + : 'EACH' + ; + +ELSE + : 'ELSE' + ; + +ELSEIF + : 'ELSEIF' + ; + +EMPTY_X + : 'EMPTY' + ; + +ENDIF + : 'ENDIF' + ; + +END + : 'END' + ; + +ENDPROPERTY + : 'ENDPROPERTY' + ; + +ENUM + : 'ENUM' + ; + +EQV + : 'EQV' + ; + +ERASE + : 'ERASE' + ; + +ERROR + : 'ERROR' + ; + +EVENT + : 'EVENT' + ; + +EXIT + : 'EXIT' + ; + +EXPLICIT + : 'EXPLICIT' + ; + +FALSE + : 'FALSE' + ; + +FIX + : 'FIX' + ; + +FRIEND + : 'FRIEND' + ; + +FOR + : 'FOR' + ; + +FUNCTION + : 'FUNCTION' + ; + +GET + : 'GET' + ; + +GLOBAL + : 'GLOBAL' + ; + +GO + : 'GO' + ; + +GOSUB + : 'GOSUB' + ; + +GOTO + : 'GOTO' + ; + +IF + : 'IF' + ; + +IMP + : 'IMP' + ; + +IMPLEMENTS + : 'IMPLEMENTS' + ; + +IN + : 'IN' + ; + +INPUT + : 'INPUT' + ; + +INPUTB + : 'INPUTB' + ; + +INT + : 'INT' + ; + +IS + : 'IS' + ; + +INTEGER + : 'INTEGER' + ; + +INTEGER_B + : '[INTEGER]' + ; + +KILL + : 'KILL' + ; + +LBOUND + : 'LBOUND' + ; + +LEN + : 'LEN' + ; + +LENB + : 'LENB' + ; + +LET + : 'LET' + ; + +LIB + : 'LIB' + ; + +LIKE + : 'LIKE' + ; + +LINE + : 'LINE' + ; + +LINEINPUT + : 'LINEINPUT' + ; + +LOCK + : 'LOCK' + ; + +LONG + : 'LONG' + ; + +LONG_B + : '[LONG]' + ; + +LONGLONG + : 'LONGLONG' + ; + +LONGLONG_B + : '[LONGLONG]' + ; + +LONGPTR + : 'LONGPTR' + ; + +LONGPTR_B + : '[LONGPTR]' + ; + +LOOP + : 'LOOP' + ; + +LSET + : 'LSET' + ; + +ME + : 'ME' + ; + +MID + : 'MID' + ; + +MIDB + : 'MIDB' + ; + +MID_D + : 'MID$' + ; + +MIDB_D + : 'MIDB$' + ; + +MOD + : 'MOD' + ; + +MODULE + : 'MODULE' + ; + +NEXT + : 'NEXT' + ; + +NEW + : 'NEW' + ; + +NOT + : 'NOT' + ; + +NOTHING + : 'NOTHING' + ; + +NULL_ + : 'NULL' + ; + +OBJECT + : 'OBJECT' + ; + +OBJECT_B + : '[OBJECT]' + ; + +ON + : 'ON' + ; + +OPEN + : 'OPEN' + ; + +OPTION + : 'OPTION' + ; + +OPTIONAL + : 'OPTIONAL' + ; + +OR + : 'OR' + ; + +OUTPUT + : 'OUTPUT' + ; + +PARAMARRAY + : 'PARAMARRAY' + ; + +PRESERVE + : 'PRESERVE' + ; + +PRINT + : 'PRINT' + ; + +PRIVATE + : 'PRIVATE' + ; + +PROPERTY + : 'PROPERTY' + ; + +PSET + : 'PSET' + ; + +PTRSAFE + : 'PTRSAFE' + ; + +PUBLIC + : 'PUBLIC' + ; + +PUT + : 'PUT' + ; + +RANDOM + : 'RANDOM' + ; + +RAISEEVENT + : 'RAISEEVENT' + ; + +READ + : 'READ' + ; + +REDIM + : 'REDIM' + ; + +REM + : 'REM' + ; + +RESET + : 'RESET' + ; + +RESUME + : 'RESUME' + ; + +RETURN + : 'RETURN' + ; + +RSET + : 'RSET' + ; - This version supports case - * insensitive - parsing without `options { caseInsensitive = true; }` - as this does not seem to be - * supported by - the TypeScript target yet. - */ +SCALE + : 'SCALE' + ; -grammar vba; +SEEK + : 'SEEK' + ; -// module ---------------------------------- - -startRule: module EOF; - -module: - WS? moduleHeader - moduleBody? endOfLine* WS?; - -moduleHeader: - endOfLine* - (moduleVerson endOfLine*)? - moduleConfig? endOfLine* - moduleAttributes? endOfLine* - moduleDeclarations? endOfLine*; - -moduleVerson: VERSION WS DOUBLELITERAL WS CLASS; - -moduleConfig: BEGIN endOfLine* moduleConfigElement+ END; - -moduleConfigElement: - ambiguousIdentifier WS? EQ WS? literal endOfLine*; - -moduleAttributes: (attributeStmt endOfLine+)+; - -moduleDeclarations: - moduleDeclarationsElement ( - endOfLine+ moduleDeclarationsElement - )* endOfLine*; - -moduleOption: - OPTION_BASE WS SHORTLITERAL # optionBaseStmt - | OPTION_COMPARE WS (BINARY | TEXT | DATABASE) # optionCompareStmt - | OPTION_EXPLICIT # optionExplicitStmt - | OPTION_PRIVATE_MODULE # optionPrivateModuleStmt; - -moduleDeclarationsElement: - comment - | declareStmt - | implementsStmt - | moduleOption; - -macroStmt: macroConstStmt | macroIfThenElseStmt; - -moduleBody: - moduleBodyElement (endOfLine+ moduleBodyElement)* endOfLine*; - -moduleBodyElement: - constStmt - | enumerationStmt - | eventStmt - | macroStmt - | methodStmt - | propertyStmt - | typeStmt - | variableStmt; - -// block ---------------------------------- - -attributeStmt: - ATTRIBUTE WS implicitCallStmt_InStmt WS? EQ WS? literal ( - WS? ',' WS? literal - )*; - -block: - ((blockStmt | foldingBlockStmt) endOfStatement)+; - -blockStmt: - lineLabel - | appactivateStmt - | attributeStmt - | beepStmt - | chdirStmt - | chdriveStmt - | closeStmt - | constStmt - | dateStmt - | deleteSettingStmt - | deftypeStmt - | endStmt - | eraseStmt - | errorStmt - | exitStmt - | explicitCallStmt - | filecopyStmt - | getStmt - | goSubStmt - | goToStmt - | ifThenElseStmt - | implementsStmt // TODO : not valid in a module!!! - | inputStmt - | killStmt - | letStmt - | lineInputStmt - | loadStmt - | lockStmt - | lsetStmt - | macroStmt - | midStmt - | mkdirStmt - | nameStmt - | onErrorStmt - | onGoToStmt - | onGoSubStmt - | openStmt - | printStmt - | putStmt - | raiseEventStmt - | randomizeStmt - | redimStmt - | resetStmt - | resumeStmt - | returnStmt - | rmdirStmt - | rsetStmt - | savepictureStmt - | saveSettingStmt - | seekStmt - | sendkeysStmt - | setattrStmt - | setStmt - | stopStmt - | timeStmt - | unloadStmt - | unlockStmt - | variableStmt - | widthStmt - | writeStmt - | implicitCallStmt_InBlock - | implicitCallStmt_InStmt; - -foldingBlockStmt: - doLoopStmt - | forEachStmt - | forNextStmt - | selectCaseStmt - | whileWendStmt - | withStmt - | ifThenElseStmt; - -// statements ---------------------------------- - -appactivateStmt: - APPACTIVATE WS valueStmt (WS? ',' WS? valueStmt)?; - -beepStmt: BEEP; - -chdirStmt: CHDIR WS valueStmt; - -chdriveStmt: CHDRIVE WS valueStmt; - -closeStmt: CLOSE (WS fileNumber (WS? ',' WS? fileNumber)*)?; - -constStmt: (visibility WS)? CONST WS constSubStmt ( - WS? ',' WS? constSubStmt - )*; - -constSubStmt: - ambiguousIdentifier typeHint? (WS asTypeClause)? WS? EQ WS? valueStmt; - -dateStmt: DATE WS? EQ WS? valueStmt; - -declareStmt: (visibility WS)? DECLARE WS (PTRSAFE WS)? ( - (FUNCTION typeHint?) - | SUB - ) WS ambiguousIdentifier typeHint? WS LIB WS STRINGLITERAL ( - WS ALIAS WS STRINGLITERAL - )? (WS? argList)? (WS asTypeClause)?; - -deftypeStmt: - ( - DEFBOOL - | DEFBYTE - | DEFINT - | DEFLNG - | DEFCUR - | DEFSNG - | DEFDBL - | DEFDEC - | DEFDATE - | DEFSTR - | DEFOBJ - | DEFVAR - ) WS letterrange (WS? ',' WS? letterrange)*; - -deleteSettingStmt: - DELETESETTING WS valueStmt WS? ',' WS? valueStmt ( - WS? ',' WS? valueStmt - )?; - -doLoopStmt: - DO endOfStatement block? LOOP - | DO WS (WHILE | UNTIL) WS valueStmt endOfStatement block? LOOP - | DO endOfStatement block LOOP WS (WHILE | UNTIL) WS valueStmt; - -endStmt: END; - -enumerationStmt: - (visibility WS)? ENUM WS ambiguousIdentifier endOfStatement enumerationStmt_Constant* END_ENUM; - -enumerationStmt_Constant: - ambiguousIdentifier (WS? EQ WS? valueStmt)? endOfStatement; - -eraseStmt: ERASE WS valueStmt (',' WS? valueStmt)*?; - -errorStmt: ERROR WS valueStmt; - -eventStmt: (visibility WS)? EVENT WS ambiguousIdentifier WS? argList; - -exitStmt: - EXIT_DO - | EXIT_FOR - | EXIT_FUNCTION - | EXIT_PROPERTY - | EXIT_SUB; +SELECT + : 'SELECT' + ; + +SET + : 'SET' + ; -filecopyStmt: FILECOPY WS valueStmt WS? ',' WS? valueStmt; +SGN + : 'SGN' + ; -forEachStmt: - FOR WS EACH WS ambiguousIdentifier typeHint? WS IN WS valueStmt endOfStatement block? NEXT ( - WS ambiguousIdentifier - )?; +SHARED + : 'SHARED' + ; -forNextStmt: - FOR WS ambiguousIdentifier typeHint? WS? - EQ WS? valueStmt WS TO WS valueStmt - (WS STEP WS valueStmt)? endOfStatement - block? - NEXT (WS ambiguousIdentifier)?; +SINGLE + : 'SINGLE' + ; -getStmt: - GET WS fileNumber WS? ',' WS? valueStmt? WS? ',' WS? valueStmt; +SINGLE_B + : '[SINGLE]' + ; -goSubStmt: GOSUB WS valueStmt; +SPC + : 'SPC' + ; -goToStmt: GOTO WS valueStmt; +STATIC + : 'STATIC' + ; -ifThenElseStmt: - inlineIfThenElseStmt - | blockIfThenElseStmt; +STEP + : 'STEP' + ; -inlineIfThenElseStmt: - IF WS ifConditionStmt WS THEN WS blockStmt (WS ELSE WS blockStmt)?; +STOP + : 'STOP' + ; -blockIfThenElseStmt: - ifBlockStmt ifElseIfBlockStmt* ifElseBlockStmt? END_IF; +STRING + : 'STRING' + ; -ifBlockStmt: - IF WS ifConditionStmt WS THEN endOfStatement block?; +STRING_B + : '[STRING]' + ; -ifConditionStmt: valueStmt; +SUB + : 'SUB' + ; -ifElseIfBlockStmt: - ELSEIF WS ifConditionStmt WS THEN endOfStatement block?; +TAB + : 'TAB' + ; -ifElseBlockStmt: ELSE endOfStatement block?; +TEXT + : 'TEXT' + ; -implementsStmt: IMPLEMENTS WS ambiguousIdentifier; +THEN + : 'THEN' + ; -inputStmt: INPUT WS fileNumber (WS? ',' WS? valueStmt)+; +TO + : 'TO' + ; -killStmt: KILL WS valueStmt; - -letStmt: (LET WS)? implicitCallStmt_InStmt WS? ( - EQ - | PLUS_EQ - | MINUS_EQ - ) WS? valueStmt; - -lineInputStmt: LINE_INPUT WS fileNumber WS? ',' WS? valueStmt; - -loadStmt: LOAD WS valueStmt; - -lockStmt: - LOCK WS valueStmt ( - WS? ',' WS? valueStmt (WS TO WS valueStmt)? - )?; - -lsetStmt: LSET WS implicitCallStmt_InStmt WS? EQ WS? valueStmt; +TRUE + : 'TRUE' + ; -macroConstStmt: - MACRO_CONST WS? ambiguousIdentifier WS? EQ WS? valueStmt; +TYPE + : 'TYPE' + ; -macroIfThenElseStmt: - macroIfBlockStmt macroElseIfBlockStmt* macroElseBlockStmt? MACRO_END_IF; +TYPEOF + : 'TYPEOF' + ; -macroIfBlockStmt: - MACRO_IF WS? ifConditionStmt WS THEN endOfStatement ( - moduleDeclarations - | moduleBody - | block - )*; +UBOUND + : 'UBOUND' + ; -macroElseIfBlockStmt: - MACRO_ELSEIF WS? ifConditionStmt WS THEN endOfStatement ( - moduleDeclarations - | moduleBody - | block - )*; +UNLOCK + : 'UNLOCK' + ; -macroElseBlockStmt: - MACRO_ELSE endOfStatement ( - moduleDeclarations - | moduleBody - | block - )*; +UNTIL + : 'UNTIL' + ; -midStmt: MID WS? LPAREN WS? argsCall WS? RPAREN; +VB_BASE + : 'VB_BASE' + ; -mkdirStmt: MKDIR WS valueStmt; +VB_CONTROL + : 'VB_CONTROL' + ; -nameStmt: NAME WS valueStmt WS AS WS valueStmt; +VB_CREATABLE + : 'VB_CREATABLE' + ; -onErrorStmt: (ON_ERROR | ON_LOCAL_ERROR) WS ( - GOTO WS valueStmt - | RESUME WS NEXT - ); +VB_CUSTOMIZABLE + : 'VB_CUSTOMIZABLE' + ; -onGoToStmt: - ON WS valueStmt WS GOTO WS valueStmt (WS? ',' WS? valueStmt)*; +VB_DESCRIPTION + : 'VB_DESCRIPTION' + ; -onGoSubStmt: - ON WS valueStmt WS GOSUB WS valueStmt (WS? ',' WS? valueStmt)*; +VB_EXPOSED + : 'VB_EXPOSED' + ; -openStmt: - OPEN WS valueStmt WS FOR WS ( - APPEND - | BINARY - | INPUT - | OUTPUT - | RANDOM - ) (WS ACCESS WS (READ | WRITE | READ_WRITE))? ( - WS (SHARED | LOCK_READ | LOCK_WRITE | LOCK_READ_WRITE) - )? WS AS WS fileNumber (WS LEN WS? EQ WS? valueStmt)?; +VB_EXT_KEY + : 'VB_EXT_KEY ' + ; -outputList: - outputList_Expression ( - WS? (';' | ',') WS? outputList_Expression? - )* - | outputList_Expression? ( - WS? (';' | ',') WS? outputList_Expression? - )+; +VB_GLOBALNAMESPACE + : 'VB_GLOBALNAMESPACE' + ; -outputList_Expression: - valueStmt - | (SPC | TAB) (WS? LPAREN WS? argsCall WS? RPAREN)?; +VB_HELPID + : 'VB_HELPID' + ; -printStmt: PRINT WS fileNumber WS? ',' (WS? outputList)?; +VB_INVOKE_FUNC + : 'VB_INVOKE_FUNC' + ; -methodStmt: - methodSignatureStmt - methodBlock - methodEndStmt - ; +VB_INVOKE_PROPERTY + : 'VB_INVOKE_PROPERTY ' + ; -propertyStmt: - propertySignatureStmt - methodBlock - methodEndStmt - ; +VB_INVOKE_PROPERTYPUT + : 'VB_INVOKE_PROPERTYPUT' + ; -methodSignatureStmt: - (visibility WS)? - (STATIC WS)? - (SUB|FUNCTION) WS? - ambiguousIdentifier typeHint? - (WS? argList) - (WS? asTypeClause)? - ; +VB_INVOKE_PROPERTYPUTREF + : 'VB_INVOKE_PROPERTYPUTREF' + ; -propertySignatureStmt: - (visibility WS)? - (STATIC WS)? - (PROPERTY_GET|PROPERTY_LET|PROPERTY_SET) WS? - ambiguousIdentifier typeHint? - (WS? argList) - (WS? asTypeClause)? - ; +VB_MEMBERFLAGS + : 'VB_MEMBERFLAGS' + ; -methodBlock: endOfStatement - (attributeStmt endOfLine)? // Optional attribute statement - (docstringStmt endOfLine)? // Optional docstring statement - block? // Optional method body +VB_NAME + : 'VB_NAME' ; -methodEndStmt: - (END_SUB | END_FUNCTION | END_PROPERTY) - ; +VB_PREDECLAREDID + : 'VB_PREDECLAREDID' + ; -putStmt: - PUT WS fileNumber WS? ',' WS? valueStmt? WS? ',' WS? valueStmt; +VB_PROCDATA + : 'VB_PROCDATA' + ; -raiseEventStmt: - RAISEEVENT WS ambiguousIdentifier ( - WS? LPAREN WS? (argsCall WS?)? RPAREN - )?; +VB_TEMPLATEDERIVED + : 'VB_TEMPLATEDERIVED' + ; -randomizeStmt: RANDOMIZE (WS valueStmt)?; +VB_USERMEMID + : 'VB_USERMEMID' + ; -redimStmt: - REDIM WS (PRESERVE WS)? redimSubStmt ( - WS? ',' WS? redimSubStmt - )*; +VB_VARDESCRIPTION + : 'VB_VARDESCRIPTION' + ; -redimSubStmt: - implicitCallStmt_InStmt WS? LPAREN WS? subscripts WS? RPAREN ( - WS asTypeClause - )?; - -resetStmt: RESET; - -resumeStmt: RESUME (WS (NEXT | ambiguousIdentifier))?; - -returnStmt: RETURN; - -rmdirStmt: RMDIR WS valueStmt; - -rsetStmt: RSET WS implicitCallStmt_InStmt WS? EQ WS? valueStmt; - -savepictureStmt: SAVEPICTURE WS valueStmt WS? ',' WS? valueStmt; - -saveSettingStmt: - SAVESETTING WS valueStmt WS? ',' WS? valueStmt WS? ',' WS? valueStmt WS? ',' WS? valueStmt; - -seekStmt: SEEK WS fileNumber WS? ',' WS? valueStmt; - -selectCaseStmt: - SELECT WS CASE WS valueStmt endOfStatement sC_Case* END_SELECT; - -sC_Selection: - IS WS? comparisonOperator WS? valueStmt # caseCondIs - | valueStmt WS TO WS valueStmt # caseCondTo - | valueStmt # caseCondValue; - -sC_Case: CASE WS sC_Cond endOfStatement block?; - -// ELSE first, so that it is not interpreted as a variable call -sC_Cond: - ELSE # caseCondElse - | sC_Selection (WS? ',' WS? sC_Selection)* # caseCondSelection; +VB_VARHELPID + : 'VB_VARHELPID' + ; -sendkeysStmt: SENDKEYS WS valueStmt (WS? ',' WS? valueStmt)?; +VB_VARMEMBERFLAGS + : 'VB_VARMEMBERFLAGS' + ; -setattrStmt: SETATTR WS valueStmt WS? ',' WS? valueStmt; +VB_VARPROCDATA + : 'VB_VARPROCDATA ' + ; -setStmt: SET WS implicitCallStmt_InStmt WS? EQ WS? valueStmt; +VB_VARUSERMEMID + : 'VB_VARUSERMEMID' + ; -stopStmt: STOP; +VARIANT + : 'VARIANT' + ; -timeStmt: TIME WS? EQ WS? valueStmt; +VARIANT_B + : '[VARIANT]' + ; -typeStmt: - (visibility WS)? TYPE WS ambiguousIdentifier endOfStatement (typeStmt_Element|macroTypeIfThenElseStmt)* END_TYPE; +VERSION + : 'VERSION' + ; -macroTypeIfThenElseStmt: - macroTypeIfBlockStmt macroTypeElseIfBlockStmt* macroTypeElseBlockStmt? MACRO_END_IF endOfStatement; +WEND + : 'WEND' + ; -macroTypeIfBlockStmt: - MACRO_IF WS? ifConditionStmt WS THEN endOfStatement typeStmt_Element*; +WHILE + : 'WHILE' + ; -macroTypeElseIfBlockStmt: - MACRO_ELSEIF WS? ifConditionStmt WS THEN endOfStatement typeStmt_Element*; +WIDTH + : 'WIDTH' + ; -macroTypeElseBlockStmt: - MACRO_ELSE endOfStatement typeStmt_Element*; +WITH + : 'WITH' + ; -typeStmt_Element: - ambiguousIdentifier (WS? LPAREN (WS? subscripts)? WS? RPAREN)? ( - WS asTypeClause - )? endOfStatement; +WITHEVENTS + : 'WITHEVENTS' + ; -typeOfStmt: TYPEOF WS valueStmt (WS IS WS type_)?; +WRITE + : 'WRITE' + ; -unloadStmt: UNLOAD WS valueStmt; +XOR + : 'XOR' + ; -unlockStmt: - UNLOCK WS fileNumber ( - WS? ',' WS? valueStmt (WS TO WS valueStmt)? - )?; +// Standard Library functions, subs, and properties +// should these be removed? +APPACTIVATE + : 'APPACTIVATE' + ; -// operator precedence is represented by rule order -valueStmt: - literal # vsLiteral - | implicitCallStmt_InStmt # vsICS - | LPAREN WS? valueStmt (WS? ',' WS? valueStmt)* RPAREN # vsStruct - | NEW WS? valueStmt # vsNew - | typeOfStmt # vsTypeOf - | midStmt # vsMid - | ADDRESSOF WS? valueStmt # vsAddressOf - | implicitCallStmt_InStmt WS? ASSIGN WS? valueStmt # vsAssign - | valueStmt WS? IS WS? valueStmt # vsIs - | valueStmt WS? LIKE WS? valueStmt # vsLike - | valueStmt WS? operatorsStmt WS? valueStmt # vsOperator - | MINUS WS? valueStmt # vsNegation - | PLUS WS? valueStmt # vsPlus - | valueStmt WS? MOD WS? valueStmt # vsMod - | valueStmt WS? IMP WS? valueStmt # vsImp - | valueStmt WS? EQV WS? valueStmt # vsEqv - | valueStmt WS? XOR WS? valueStmt # vsXor - | valueStmt WS? OR WS? valueStmt # vsOr - | valueStmt WS? AND WS? valueStmt # vsAnd - | NOT WS? valueStmt # vsNot; +COLLECTION + : 'COLLECTION' + ; -operatorsStmt: - (GEQ - | LEQ - | GT - | LT - | NEQ - | EQ - | POW - | DIV - | MULT - | PLUS - | MINUS - | AMPERSAND - )+; +DATABASE + : 'DATABASE' + ; + +DELETESETTING + : 'DELETESETTING' + ; -variableStmt: (DIM | STATIC | visibility) WS (WITHEVENTS WS)? variableListStmt; +FILECOPY + : 'FILECOPY' + ; -variableListStmt: - variableSubStmt (WS? ',' WS? variableSubStmt)*; +MKDIR + : 'MKDIR' + ; -variableSubStmt: - ambiguousIdentifier ( - WS? LPAREN WS? (subscripts WS?)? RPAREN WS? - )? typeHint? (WS asTypeClause)?; +NAME + : 'NAME' + ; -whileWendStmt: WHILE WS valueStmt endOfStatement block? WEND; +RANDOMIZE + : 'RANDOMIZE' + ; -widthStmt: WIDTH WS fileNumber WS? ',' WS? valueStmt; +RMDIR + : 'RMDIR' + ; -withStmt: - WITH WS (implicitCallStmt_InStmt | (NEW WS type_)) endOfStatement block? END_WITH; +SAVEPICTURE + : 'SAVEPICTURE' + ; -writeStmt: WRITE WS fileNumber WS? ',' (WS? outputList)?; +SAVESETTING + : 'SAVESETTING' + ; -fileNumber: '#'? valueStmt; +SENDKEYS + : 'SENDKEYS' + ; -// complex call statements ---------------------------------- +SETATTR + : 'SETATTR' + ; -explicitCallStmt: eCS_ProcedureCall | eCS_MemberProcedureCall; +TIME + : 'TIME' + ; -// parantheses are required in case of args -> empty parantheses are removed -eCS_ProcedureCall: - CALL WS ambiguousIdentifier typeHint? ( - WS? LPAREN WS? argsCall WS? RPAREN - )? (WS? LPAREN subscripts RPAREN)*; - -// parantheses are required in case of args -> empty parantheses are removed -eCS_MemberProcedureCall: - CALL WS implicitCallStmt_InStmt? '.' ambiguousIdentifier typeHint? ( - WS? LPAREN WS? argsCall WS? RPAREN - )? (WS? LPAREN subscripts RPAREN)*; - -implicitCallStmt_InBlock: - iCS_B_MemberProcedureCall - | iCS_B_ProcedureCall; - -iCS_B_MemberProcedureCall: - implicitCallStmt_InStmt? '.' ambiguousIdentifier typeHint? ( - WS argsCall - )? dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*; - -// parantheses are forbidden in case of args variables cannot be called in blocks certainIdentifier -// instead of ambiguousIdentifier for preventing ambiguity with statement keywords -iCS_B_ProcedureCall: - certainIdentifier (WS? argsCall)? ( - WS? LPAREN subscripts RPAREN - )*; - -// iCS_S_MembersCall first, so that member calls are not resolved as separate iCS_S_VariableOrProcedureCalls -implicitCallStmt_InStmt: - iCS_S_MembersCall - | iCS_S_VariableOrProcedureCall - | iCS_S_ProcedureOrArrayCall - | iCS_S_DictionaryCall; - -iCS_S_VariableOrProcedureCall: - ambiguousIdentifier typeHint? dictionaryCallStmt? ( - WS? LPAREN subscripts RPAREN - )*; - -iCS_S_ProcedureOrArrayCall: (ambiguousIdentifier | baseType) typeHint? WS? LPAREN WS? ( - argsCall WS? - )? RPAREN dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*; - -iCS_S_MembersCall: ( - iCS_S_VariableOrProcedureCall - | iCS_S_ProcedureOrArrayCall - )? iCS_S_MemberCall+ dictionaryCallStmt? ( - WS? LPAREN subscripts RPAREN - )*; - -iCS_S_MemberCall: - LINE_CONTINUATION? ('.' | '!') LINE_CONTINUATION? ( - iCS_S_VariableOrProcedureCall - | iCS_S_ProcedureOrArrayCall - ); - -iCS_S_DictionaryCall: dictionaryCallStmt; - -// atomic call statements ---------------------------------- - -argsCall: (WS? argCall? WS? (',' | ';') WS?)* argCall ( - WS? (',' | ';') WS? argCall? - )*; - -argCall: - LINE_CONTINUATION? LPAREN? ((BYVAL | BYREF | PARAMARRAY) WS)? RPAREN? valueStmt; - -dictionaryCallStmt: '!' ambiguousIdentifier typeHint?; - -// atomic rules for statements - -argList: LPAREN (WS? arg (WS? ',' WS? arg)*)? WS? RPAREN; - -arg: (OPTIONAL WS)? ((BYVAL | BYREF) WS)? (PARAMARRAY WS)? ambiguousIdentifier typeHint? ( - WS? LPAREN WS? RPAREN - )? (WS? asTypeClause)? (WS? argDefaultValue)?; - -argDefaultValue: EQ WS? valueStmt; - -subscripts: subscript_ (WS? ',' WS? subscript_)*; - -subscript_: (valueStmt WS TO WS)? valueStmt; - -// atomic rules ---------------------------------- - -ambiguousIdentifier: (IDENTIFIER | ambiguousKeyword)+; - -asTypeClause: AS WS? (NEW WS)? type_ (WS? fieldLength)?; - -baseType: - BOOLEAN - | BYTE - | COLLECTION - | DATE - | DOUBLE - | INTEGER - | LONG - | SINGLE - | STRING (WS? MULT WS? valueStmt)? - | VARIANT; - -certainIdentifier: - IDENTIFIER (ambiguousKeyword | IDENTIFIER)* - | ambiguousKeyword (ambiguousKeyword | IDENTIFIER)+; - -comparisonOperator: LT | LEQ | GT | GEQ | EQ | NEQ | IS | LIKE; - -complexType: - ambiguousIdentifier (('.' | '!') ambiguousIdentifier)*; - -fieldLength: MULT WS? (INTEGERLITERAL | ambiguousIdentifier); - -letterrange: - certainIdentifier (WS? MINUS WS? certainIdentifier)?; - -lineLabel: ambiguousIdentifier WS? (':' | COLON); - -literal: - HEXLITERAL - | OCTLITERAL - | DATELITERAL - | DOUBLELITERAL - | INTEGERLITERAL - | SHORTLITERAL - | STRINGLITERAL - | TRUE - | FALSE - | NOTHING - | NULL_; - -type_: (baseType | complexType) (WS? LPAREN WS? RPAREN)?; - -typeHint: '&' | '%' | '#' | '!' | '@' | '$' | POW; - -visibility: PRIVATE | PUBLIC | FRIEND | GLOBAL; - -// ambiguous keywords -ambiguousKeyword: - ACCESS - | ADDRESSOF - | ALIAS - | AND - | ATTRIBUTE - | APPACTIVATE - | APPEND - | AS - | BEEP - | BEGIN - | BINARY - | BOOLEAN - | BYVAL - | BYREF - | BYTE - | CALL - | CASE - | CLASS - | CLOSE - | CHDIR - | CHDRIVE - | COLLECTION - | CONST - | DATABASE - | DATE - | DECLARE - | DEFBOOL - | DEFBYTE - | DEFCUR - | DEFDBL - | DEFDATE - | DEFDEC - | DEFINT - | DEFLNG - | DEFOBJ - | DEFSNG - | DEFSTR - | DEFVAR - | DELETESETTING - | DIM - | DO - | DOUBLE - | EACH - | ELSE - | ELSEIF - | END - | ENUM - | EQV - | ERASE - | ERROR - | EVENT - | FALSE - | FILECOPY - | FRIEND - | FOR - | FUNCTION - | GET - | GLOBAL - | GOSUB - | GOTO - | IF - | IMP - | IMPLEMENTS - | IN - | INPUT - | IS - | INTEGER - | KILL - | LOAD - | LOCK - | LONG - | LOOP - | LEN - | LET - | LIB - | LIKE - | LSET - | ME - | MID - | MKDIR - | MOD - | NAME - | NEXT - | NEW - | NOT - | NOTHING - | NULL_ - | ON - | OPEN - | OPTIONAL - | OR - | OUTPUT - | PARAMARRAY - | PRESERVE - | PRINT - | PRIVATE - | PUBLIC - | PUT - | RANDOM - | RANDOMIZE - | RAISEEVENT - | READ - | REDIM - | REM - | RESET - | RESUME - | RETURN - | RMDIR - | RSET - | SAVEPICTURE - | SAVESETTING - | SEEK - | SELECT - | SENDKEYS - | SET - | SETATTR - | SHARED - | SINGLE - | SPC - | STATIC - | STEP - | STOP - | STRING - | SUB - | TAB - | TEXT - | THEN - | TIME - | TO - | TRUE - | TYPE - | TYPEOF - | UNLOAD - | UNLOCK - | UNTIL - | VARIANT - | VERSION - | WEND - | WHILE - | WIDTH - | WITH - | WITHEVENTS - | WRITE - | XOR; - -remComment: REMCOMMENT; - -comment: COMMENT; - -docstringStmt: (WS? (COMMENT | REMCOMMENT) WS? NEWLINE*)+; - -endOfLine: WS? (NEWLINE | comment | remComment) WS?; - -endOfStatement: (endOfLine | WS? COLON WS?)*; - - -// lexer rules -------------------------------------------------------------------------------- - -// Case insensitive letters -fragment A: ('A' | 'a'); -fragment B: ('B' | 'b'); -fragment C: ('C' | 'c'); -fragment D: ('D' | 'd'); -fragment E: ('E' | 'e'); -fragment F: ('F' | 'f'); -fragment G: ('G' | 'g'); -fragment H: ('H' | 'h'); -fragment I: ('I' | 'i'); -fragment J: ('J' | 'j'); -fragment K: ('K' | 'k'); -fragment L: ('L' | 'l'); -fragment M: ('M' | 'm'); -fragment N: ('N' | 'n'); -fragment O: ('O' | 'o'); -fragment P: ('P' | 'p'); -fragment Q: ('Q' | 'q'); -fragment R: ('R' | 'r'); -fragment S: ('S' | 's'); -fragment T: ('T' | 't'); -fragment U: ('U' | 'u'); -fragment V: ('V' | 'v'); -fragment W: ('W' | 'w'); -fragment X: ('X' | 'x'); -fragment Y: ('Y' | 'y'); -fragment Z: ('Z' | 'z'); -fragment HASH: '#'; +LOAD + : 'LOAD' + ; -// keywords -ACCESS: A C C E S S; -ADDRESSOF: A D D R E S S O F; -ALIAS: A L I A S; -AND: A N D; -ATTRIBUTE: A T T R I B U T E; -APPACTIVATE: A P P A C T I V A T E; -APPEND: A P P E N D; -AS: A S; -BEGIN: B E G I N; -BEEP: B E E P; -BINARY: B I N A R Y; -BOOLEAN: B O O L E A N; -BYVAL: B Y V A L; -BYREF: B Y R E F; -BYTE: B Y T E; -CALL: C A L L; -CASE: C A S E; -CHDIR: C H D I R; -CHDRIVE: C H D R I V E; -CLASS: C L A S S; -CLOSE: C L O S E; -COLLECTION: C O L L E C T I O N; -CONST: C O N S T; -DATABASE: D A T A B A S E; -DATE: D A T E; -DECLARE: D E C L A R E; -DEFBOOL: D E F B O O L; -DEFBYTE: D E F B Y T E; -DEFDATE: D E F D A T E; -DEFDBL: D E F D B L; -DEFDEC: D E F D E C; -DEFCUR: D E F C U R; -DEFINT: D E F I N T; -DEFLNG: D E F L N G; -DEFOBJ: D E F O B J; -DEFSNG: D E F S N G; -DEFSTR: D E F S T R; -DEFVAR: D E F V A R; -DELETESETTING: D E L E T E S E T T I N G; -DIM: D I M; -DO: D O; -DOUBLE: D O U B L E; -EACH: E A C H; -ELSE: E L S E; -ELSEIF: E L S E I F; -END_ENUM: E N D WS E N U M; -END_FUNCTION: E N D WS F U N C T I O N; -END_IF: E N D WS I F; -END_PROPERTY: E N D WS P R O P E R T Y; -END_SELECT: E N D WS S E L E C T; -END_SUB: E N D WS S U B; -END_TYPE: E N D WS T Y P E; -END_WITH: E N D WS W I T H; -END: E N D; -ENUM: E N U M; -EQV: E Q V; -ERASE: E R A S E; -ERROR: E R R O R; -EVENT: E V E N T; -EXIT_DO: E X I T WS D O; -EXIT_FOR: E X I T WS F O R; -EXIT_FUNCTION: E X I T WS F U N C T I O N; -EXIT_PROPERTY: E X I T WS P R O P E R T Y; -EXIT_SUB: E X I T WS S U B; -FALSE: F A L S E; -FILECOPY: F I L E C O P Y; -FRIEND: F R I E N D; -FOR: F O R; -FUNCTION: F U N C T I O N; -GET: G E T; -GLOBAL: G L O B A L; -GOSUB: G O S U B; -GOTO: G O T O; -IF: I F; -IMP: I M P; -IMPLEMENTS: I M P L E M E N T S; -IN: I N; -INPUT: I N P U T; -IS: I S; -INTEGER: I N T E G E R; -KILL: K I L L; -LOAD: L O A D; -LOCK: L O C K; -LONG: L O N G; -LOOP: L O O P; -LEN: L E N; -LET: L E T; -LIB: L I B; -LIKE: L I K E; -LINE_INPUT: L I N E WS I N P U T; -LOCK_READ: L O C K WS R E A D; -LOCK_WRITE: L O C K WS W R I T E; -LOCK_READ_WRITE: L O C K WS R E A D WS W R I T E; -LSET: L S E T; -MACRO_CONST: HASH C O N S T; -MACRO_IF: HASH I F; -MACRO_ELSEIF: HASH E L S E I F; -MACRO_ELSE: HASH E L S E; -MACRO_END_IF: HASH E N D WS? I F; -ME: M E; -MID: M I D; -MKDIR: M K D I R; -MOD: M O D; -NAME: N A M E; -NEXT: N E X T; -NEW: N E W; -NOT: N O T; -NOTHING: N O T H I N G; -NULL_: N U L L; -ON: O N; -ON_ERROR: O N WS E R R O R; -ON_LOCAL_ERROR: O N WS L O C A L WS E R R O R; -OPEN: O P E N; -OPTIONAL: O P T I O N A L; -OPTION_BASE: O P T I O N WS B A S E; -OPTION_EXPLICIT: O P T I O N WS E X P L I C I T; -OPTION_COMPARE: O P T I O N WS C O M P A R E; -OPTION_PRIVATE_MODULE: - O P T I O N WS P R I V A T E WS M O D U L E; -OR: O R; -OUTPUT: O U T P U T; -PARAMARRAY: P A R A M A R R A Y; -PRESERVE: P R E S E R V E; -PRINT: P R I N T; -PRIVATE: P R I V A T E; -PROPERTY_GET: P R O P E R T Y WS G E T; -PROPERTY_LET: P R O P E R T Y WS L E T; -PROPERTY_SET: P R O P E R T Y WS S E T; -PTRSAFE: P T R S A F E; -PUBLIC: P U B L I C; -PUT: P U T; -RANDOM: R A N D O M; -RANDOMIZE: R A N D O M I Z E; -RAISEEVENT: R A I S E E V E N T; -READ: R E A D; -READ_WRITE: R E A D WS W R I T E; -REDIM: R E D I M; -REM: R E M; -RESET: R E S E T; -RESUME: R E S U M E; -RETURN: R E T U R N; -RMDIR: R M D I R; -RSET: R S E T; -SAVEPICTURE: S A V E P I C T U R E; -SAVESETTING: S A V E S E T T I N G; -SEEK: S E E K; -SELECT: S E L E C T; -SENDKEYS: S E N D K E Y S; -SET: S E T; -SETATTR: S E T A T T R; -SHARED: S H A R E D; -SINGLE: S I N G L E; -SPC: S P C; -STATIC: S T A T I C; -STEP: S T E P; -STOP: S T O P; -STRING: S T R I N G; -SUB: S U B; -TAB: T A B; -TEXT: T E X T; -THEN: T H E N; -TIME: T I M E; -TO: T O; -TRUE: T R U E; -TYPE: T Y P E; -TYPEOF: T Y P E O F; -UNLOAD: U N L O A D; -UNLOCK: U N L O C K; -UNTIL: U N T I L; -VARIANT: V A R I A N T; -VERSION: V E R S I O N; -WEND: W E N D; -WHILE: W H I L E; -WIDTH: W I D T H; -WITH: W I T H; -WITHEVENTS: W I T H E V E N T S; -WRITE: W R I T E; -XOR: X O R; +UNLOAD + : 'UNLOAD' + ; // symbols -AMPERSAND: '&'; -ASSIGN: ':='; -DIV: '\\' | '/'; -EQ: '='; -GEQ: '>='; -GT: '>'; -LEQ: '<='; -LPAREN: '('; -LT: '<'; -MINUS: '-'; -MINUS_EQ: '-='; -MULT: '*'; -NEQ: '<>'; -PLUS: '+'; -PLUS_EQ: '+='; -POW: '^'; -RPAREN: ')'; -L_SQUARE_BRACKET: '['; -R_SQUARE_BRACKET: ']'; +AMPERSAND + : '&' + ; + +ASPERAND + : '@' + ; + +ASSIGN + : ':=' + ; + +COMMA + : ',' + ; + +DIV + : '\\' + | '/' + ; +Dollar + : '$' + ; +EQ + : '=' + ; +EXCLAM + : '!' + ; +GEQ + : '>=' + | '=>' + ; + +GT + : '>' + ; + +HASH + : '#' + ; +LEQ + : '<=' + | '=<' + ; + +LPAREN + : '(' + ; + +LT + : '<' + ; + +MINUS + : '-' + ; + +MINUS_EQ + : '-=' + ; + +MULT + : '*' + ; + +NEQ + : '<>' + | '><' + ; + +PERCENT + : '%' + ; + +PERIOD + : '.' + ; + +PLUS + : '+' + ; + +PLUS_EQ + : '+=' + ; + +POW + : '^' + ; + +RPAREN + : ')' + ; + +SEMICOLON + : ';' + ; + +L_SQUARE_BRACKET + : '[' + ; + +R_SQUARE_BRACKET + : ']' + ; // literals -STRINGLITERAL: '"' (~["\r\n] | '""')* '"'; -OCTLITERAL: '&O' [0-7]+ '&'?; -HEXLITERAL: '&H' [0-9A-F]+ '&'?; -SHORTLITERAL: (PLUS | MINUS)? DIGIT+ ('#' | '&' | '@' | '^')?; -INTEGERLITERAL: SHORTLITERAL (E SHORTLITERAL)?; -DOUBLELITERAL: (PLUS | MINUS)? DIGIT* '.' DIGIT+ (E SHORTLITERAL)?; -DATELITERAL: '#' DATEORTIME '#'; -fragment DATEORTIME: - DATEVALUE WS? TIMEVALUE - | DATEVALUE - | TIMEVALUE; -fragment DATEVALUE: - DATEVALUEPART DATESEPARATOR DATEVALUEPART ( - DATESEPARATOR DATEVALUEPART - )?; -fragment DATEVALUEPART: DIGIT+ | MONTHNAME; -fragment DATESEPARATOR: WS? [/,-]? WS?; -fragment MONTHNAME: ENGLISHMONTHNAME | ENGLISHMONTHABBREVIATION; -fragment ENGLISHMONTHNAME: - J A N U A R Y - | F E B R U A R Y - | M A R C H - | A P R I L - | M A Y - | J U N E - | A U G U S T - | S E P T E M B E R - | O C T O B E R - | N O V E M B E R - | D E C E M B E R; -fragment ENGLISHMONTHABBREVIATION: - J A N - | F E B - | M A R - | A P R - | J U N - | J U L - | A U G - | S E P - | O C T - | N O V - | D E C; -fragment TIMEVALUE: - DIGIT+ AMPM - | DIGIT+ TIMESEPARATOR DIGIT+ (TIMESEPARATOR DIGIT+)? AMPM?; -fragment TIMESEPARATOR: WS? (' :' | '.') WS?; -fragment AMPM: WS? (A M | P M | A | P); +fragment BLOCK + : HEXDIGIT HEXDIGIT HEXDIGIT HEXDIGIT + ; + +GUID + : '{' BLOCK BLOCK MINUS BLOCK MINUS BLOCK MINUS BLOCK MINUS BLOCK BLOCK BLOCK '}' + ; + +STRINGLITERAL + : '"' (~["\r\n] | '""')* '"' + ; + +INTEGERLITERAL + : (DIGIT DIGIT* + | '&H' [0-9A-F]+ + | '&' [O]? [0-7]+) [%&^]? + ; + +FLOATLITERAL + : FLOATINGPOINTLITERAL [!#@]? + | DECIMALLITERAL [!#@] + ; + +fragment FLOATINGPOINTLITERAL + : DECIMALLITERAL [DE] [+-]? DECIMALLITERAL + | DECIMALLITERAL '.' DECIMALLITERAL? ([DE] [+-]? DECIMALLITERAL)? + | '.' DECIMALLITERAL ([DE] [+-]? DECIMALLITERAL)? + ; + +fragment DECIMALLITERAL + : DIGIT DIGIT* + ; + +DATELITERAL + : '#' DATEORTIME '#' + ; + +fragment DATEORTIME + : DATEVALUE WS+ TIMEVALUE + | DATEVALUE + | TIMEVALUE + ; + +fragment DATEVALUE + : DATEVALUEPART DATESEPARATOR DATEVALUEPART (DATESEPARATOR DATEVALUEPART)? + ; + +fragment DATEVALUEPART + : DIGIT+ + | MONTHNAME + ; + +fragment DATESEPARATOR + : WS+ + | WS? [/,-] WS? + ; + +fragment MONTHNAME + : ENGLISHMONTHNAME + | ENGLISHMONTHABBREVIATION + ; + +fragment ENGLISHMONTHNAME + : 'JANUARY' + | 'FEBRUARY' + | 'MARCH' + | 'APRIL' + | 'MAY' + | 'JUNE' + | 'JULY' + | 'AUGUST' + | 'SEPTEMBER' + | 'OCTOBER' + | 'NOVEMBER' + | 'DECEMBER' + ; + +// May has intentionally been left out +fragment ENGLISHMONTHABBREVIATION + : 'JAN' + | 'FEB' + | 'MAR' + | 'APR' + | 'JUN' + | 'JUL' + | 'AUG' + | 'SEP' + | 'OCT' + | 'NOV' + | 'DEC' + ; +fragment TIMEVALUE + : DIGIT+ AMPM + | DIGIT+ TIMESEPARATOR DIGIT+ (TIMESEPARATOR DIGIT+)? AMPM? + ; + +fragment TIMESEPARATOR + : WS? (':' | '.') WS? + ; + +fragment AMPM + : WS? ('AM' | 'PM' | 'A' | 'P') + ; + +FILEOFFSET + : '$'? STRINGLITERAL ':' HEXDIGIT+ + ; // whitespace, line breaks, comments, ... -LINE_CONTINUATION: [ \t]+ UNDERSCORE '\r'? '\n' WS* -> skip; -SINGLENEWLINE: [\r\n\u2028\u2029]; -NEWLINE: (SINGLENEWLINE)+; -REMCOMMENT: - COLON? REM WS (LINE_CONTINUATION | ~[\r\n\u2028\u2029])*; -COMMENT: SINGLEQUOTE (LINE_CONTINUATION | ~[\r\n\u2028\u2029])*; -SINGLEQUOTE: '\''; -COLON: ' :'; -UNDERSCORE: '_'; -WS: ([ \t] | LINE_CONTINUATION)+; +LINE_CONTINUATION + : WS UNDERSCORE WS? '\r'? '\n' + ; + +NEWLINE + : [\r\n\u2028\u2029]+ + ; + +REMCOMMENT + : COLON? REM WS (LINE_CONTINUATION | ~[\r\n\u2028\u2029])* + ; + +COMMENT + : SINGLEQUOTE (LINE_CONTINUATION | ~[\r\n\u2028\u2029])* + ; + +SINGLEQUOTE + : '\'' + ; + +COLON + : ':' + ; + +UNDERSCORE + : '_' + ; + +WS + : ([ \t\u0019\u3000])+ + ; + +MACRO_LINE + : (WS? '#IF' ~[\r\n\u2028\u2029]* THEN COMMENT? + | WS? '#ELSEIF' ~[\r\n\u2028\u2029]* THEN COMMENT? + | WS? '#ELSE' COMMENT? + | WS? ('#END If'|'#endif') COMMENT?) -> channel(HIDDEN) + ; // identifier -IDENTIFIER: - ~[\]()\r\n\t.,'"|!@#$%^&*\-+:=; ]+ - | L_SQUARE_BRACKET (~[!\]\r\n])+ R_SQUARE_BRACKET; +IDENTIFIER + : [A-Z][A-Z0-9_]* + ; + +FOREIGN_NAME + : '[' ~[\r\n\u2028\u2029]* ']' + ; // letters -fragment LETTER: [A-Z_\p{L}]; -fragment DIGIT: [0-9]; -fragment LETTERORDIGIT: [A-Z0-9_\p{L}]; +fragment LETTER + : [A-Z_\p{L}] + ; + +fragment DIGIT + : [0-9] + ; + +fragment HEXDIGIT + : [A-F0-9] + ; -NWS: .; \ No newline at end of file +fragment LETTERORDIGIT + : [A-Z0-9_\p{L}] + ; \ No newline at end of file diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index e4a8691..ea99870 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,12 +1,7 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; -import { ANTLRInputStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, Parser, RecognitionException, Recognizer } from 'antlr4ts'; - -import { ErrorNode } from 'antlr4ts/tree/ErrorNode'; -import { ParseTreeWalker } from 'antlr4ts/tree/ParseTreeWalker'; - -import { vbaLexer as VbaLexer } from '../../antlr/out/vbaLexer'; -import { AttributeStmtContext, ConstStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, FoldingBlockStmtContext, MethodStmtContext, ModuleContext, ModuleHeaderContext, OperatorsStmtContext, TypeStmtContext, VariableStmtContext, vbaParser as VbaParser, WhileWendStmtContext } from '../../antlr/out/vbaParser'; +import { vbaLexer } from '../../antlr/out/vbaLexer'; +import { ModuleContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -17,6 +12,7 @@ import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; import { OperatorElement } from '../elements/operator'; import { WhileWendLoopElement } from '../elements/flow'; +import { CharStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException, Recognizer } from 'antlr4ng'; export class SyntaxParser { private static _lockIdentifier = 0; @@ -62,7 +58,8 @@ export class SyntaxParser { } parse(document: VbaClassDocument | VbaModuleDocument) { - const listener = new VbaTreeWalkListener(document); + console.info('Parsing the document.'); + const listener = new VbaListener(document); const parser = this.createParser(document.textDocument); ParseTreeWalker.DEFAULT.walk( listener, @@ -71,131 +68,242 @@ export class SyntaxParser { } private createParser(doc: TextDocument): VbaParser { - const lexer = new VbaLexer(new ANTLRInputStream(doc.getText())); + const lexer = new VbaLexer(CharStream.fromString(doc.getText())); const parser = new VbaParser(new CommonTokenStream(lexer)); parser.removeErrorListeners(); - parser.addErrorListener(new VbaErrorListener()); parser.errorHandler = new VbaErrorHandler(); return parser; } } +class VbaLexer extends vbaLexer { + constructor(input: CharStream) { + super(input); + } +} + +class VbaParser extends vbaParser { -class VbaTreeWalkListener implements vbaListener { +} + +class VbaListener extends vbaListener { document: VbaClassDocument | VbaModuleDocument; constructor(document: VbaClassDocument | VbaModuleDocument) { + super(); this.document = document; } - visitErrorNode(node: ErrorNode) { - console.log(node.payload); - } - - enterAttributeStmt = (ctx: AttributeStmtContext) => { - this.document.activeAttributeElement?.processAttribute(ctx); - }; - - enterConstStmt = (ctx: ConstStmtContext) => { - const element = new ConstDeclarationsElement(ctx, this.document.textDocument); - element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); - }; - - enterEnumerationStmt = (ctx: EnumerationStmtContext) => { - const element = new EnumBlockDeclarationElement(ctx, this.document.textDocument); - this.document.registerFoldableElement(element) - .registerSemanticToken(element) - .registerSymbolInformation(element) - .registerScopedElement(element); - }; - - exitEnumerationStmt = (_: EnumerationStmtContext) => { - this.document.deregisterScopedElement(); - }; - - enterEnumerationStmt_Constant = (ctx: EnumerationStmt_ConstantContext) => { - const element = new EnumMemberDeclarationElement(ctx, this.document.textDocument); - this.document.registerSymbolInformation(element) - .registerSemanticToken(element); - }; - - enterFoldingBlockStmt = (ctx: FoldingBlockStmtContext) => { - const element = new FoldableElement(ctx, this.document.textDocument); - this.document.registerFoldableElement(element); - }; - - enterMethodStmt = (ctx: MethodStmtContext) => { - const element = new MethodBlockDeclarationElement(ctx, this.document.textDocument); - this.document.registerNamedElement(element) - .registerFoldableElement(element) - .registerSymbolInformation(element) - .registerSemanticToken(element) - .registerScopedElement(element); - }; - - exitMethodStmt = (_: MethodStmtContext) => { - this.document.deregisterScopedElement(); - }; - + // visitErrorNode(node: ErrorNode) { + // console.log(node.payload); + // } + + // enterAttributeStmt = (ctx: AttributeStmtContext) => { + // this.document.activeAttributeElement?.processAttribute(ctx); + // }; + + // enterConstStmt = (ctx: ConstStmtContext) => { + // const element = new ConstDeclarationsElement(ctx, this.document.textDocument); + // element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); + // }; + + // enterEnumerationStmt = (ctx: EnumerationStmtContext) => { + // const element = new EnumBlockDeclarationElement(ctx, this.document.textDocument); + // this.document.registerFoldableElement(element) + // .registerSemanticToken(element) + // .registerSymbolInformation(element) + // .registerScopedElement(element); + // }; + + // exitEnumerationStmt = (_: EnumerationStmtContext) => { + // this.document.deregisterScopedElement(); + // }; + + // enterEnumerationStmt_Constant = (ctx: EnumerationStmt_ConstantContext) => { + // const element = new EnumMemberDeclarationElement(ctx, this.document.textDocument); + // this.document.registerSymbolInformation(element) + // .registerSemanticToken(element); + // }; + + // enterFoldingBlockStmt = (ctx: FoldingBlockStmtContext) => { + // const element = new FoldableElement(ctx, this.document.textDocument); + // this.document.registerFoldableElement(element); + // }; + + // enterMethodStmt = (ctx: MethodStmtContext) => { + // const element = new MethodBlockDeclarationElement(ctx, this.document.textDocument); + // this.document.registerNamedElement(element) + // .registerFoldableElement(element) + // .registerSymbolInformation(element) + // .registerSemanticToken(element) + // .registerScopedElement(element); + // }; + + // exitMethodStmt = (_: MethodStmtContext) => { + // this.document.deregisterScopedElement(); + // }; + + // enterModule = (ctx: ModuleContext) => { + // const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); + // this.document.registerAttributeElement(element) + // .registerDiagnosticElement(element) + // .registerScopedElement(element); + // }; + + // exitModule = (_: ModuleContext) => { + // const element = this.document.deregisterAttributeElement() as ModuleElement; + // this.document.registerSymbolInformation(element) + // .deregisterScopedElement() + // .deregisterAttributeElement(); + // }; + + // enterModuleHeader = (ctx: ModuleHeaderContext) => { + // const element = new FoldableElement(ctx, this.document.textDocument); + // this.document.registerFoldableElement(element); + // }; + + // enterOperatorsStmt = (ctx: OperatorsStmtContext) => { + // const element = new OperatorElement(ctx, this.document.textDocument); + // this.document.registerDiagnosticElement(element); enterModule = (ctx: ModuleContext) => { const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); this.document.registerAttributeElement(element) - .registerDiagnosticElement(element) .registerScopedElement(element); }; - exitModule = (_: ModuleContext) => { - const element = this.document.deregisterAttributeElement() as ModuleElement; - this.document.registerSymbolInformation(element) - .deregisterScopedElement() - .deregisterAttributeElement(); - }; - - enterModuleHeader = (ctx: ModuleHeaderContext) => { - const element = new FoldableElement(ctx, this.document.textDocument); - this.document.registerFoldableElement(element); - }; - - enterOperatorsStmt = (ctx: OperatorsStmtContext) => { - const element = new OperatorElement(ctx, this.document.textDocument); - this.document.registerDiagnosticElement(element); - }; - - enterTypeStmt = (ctx: TypeStmtContext) => { - const element = new TypeDeclarationElement(ctx, this.document.textDocument); - this.document.registerSymbolInformation(element) - .registerSemanticToken(element); - }; - - enterVariableStmt = (ctx: VariableStmtContext) => { - const element = new VariableDeclarationsElement(ctx, this.document.textDocument); - element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); - }; - - enterWhileWendStmt = (ctx: WhileWendStmtContext) => { - const element = new WhileWendLoopElement(ctx, this.document.textDocument); - this.document.registerDiagnosticElement(element); - }; + // enterTypeStmt = (ctx: TypeStmtContext) => { + // const element = new TypeDeclarationElement(ctx, this.document.textDocument); + // this.document.registerSymbolInformation(element) + // .registerSemanticToken(element); + // }; + + // enterVariableStmt = (ctx: VariableStmtContext) => { + // const element = new VariableDeclarationsElement(ctx, this.document.textDocument); + // element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); + // }; + + // enterWhileWendStmt = (ctx: WhileWendStmtContext) => { + // const element = new WhileWendLoopElement(ctx, this.document.textDocument); + // this.document.registerDiagnosticElement(element); + // }; } class VbaErrorHandler extends DefaultErrorStrategy { recover(recognizer: Parser, e: RecognitionException): void { const inputStream = recognizer.inputStream; - if (!recognizer.isMatchedEOF) { + // if (!recognizer.isMatchedEOF) { inputStream.consume(); - } + // } this.endErrorCondition(recognizer); } } -class VbaErrorListener extends ConsoleErrorListener { - syntaxError(recognizer: Recognizer, offendingSymbol: T, line: number, charPositionInLine: number, msg: string, e: RecognitionException | undefined): void { - super.syntaxError(recognizer, offendingSymbol, line, charPositionInLine, msg, e); - console.error(e); - if (e) { - const y = recognizer.getErrorHeader(e); - console.log(y); - } - } -} +// class VbaErrorListener extends ConsoleErrorListener { +// syntaxError(recognizer: Recognizer, offendingSymbol: T, line: number, charPositionInLine: number, msg: string, e: RecognitionException | undefined): void { +// super.syntaxError(recognizer, offendingSymbol, line, charPositionInLine, msg, e); +// console.error(e); +// if (e) { +// const y = recognizer.getErrorHeader(e); +// console.log(y); +// } +// } +// } + +// class VbaTreeWalkListener implements vbaListener { +// document: VbaClassDocument | VbaModuleDocument; + +// constructor(document: VbaClassDocument | VbaModuleDocument) { +// this.document = document; +// } + +// visitErrorNode(node: ErrorNode) { +// console.log(node.payload); +// } + +// enterAttributeStmt = (ctx: AttributeStmtContext) => { +// this.document.activeAttributeElement?.processAttribute(ctx); +// }; + +// enterConstStmt = (ctx: ConstStmtContext) => { +// const element = new ConstDeclarationsElement(ctx, this.document.textDocument); +// element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); +// }; + +// enterEnumerationStmt = (ctx: EnumerationStmtContext) => { +// const element = new EnumBlockDeclarationElement(ctx, this.document.textDocument); +// this.document.registerFoldableElement(element); +// this.document.registerSemanticToken(element); +// this.document.registerSymbolInformation(element); +// this.document.registerScopedElement(element); +// }; + +// exitEnumerationStmt = (_: EnumerationStmtContext) => { +// console.warn("Entered enum statement."); +// this.document.deregisterScopedElement(); +// }; + +// enterEnumerationStmt_Constant = (ctx: EnumerationStmt_ConstantContext) => { +// const element = new EnumMemberDeclarationElement(ctx, this.document.textDocument); +// this.document.registerSymbolInformation(element); +// this.document.registerSemanticToken(element); +// }; + +// enterFoldingBlockStmt = (ctx: FoldingBlockStmtContext) => { +// const element = new FoldableElement(ctx, this.document.textDocument); +// this.document.registerFoldableElement(element); +// }; + +// enterMethodStmt = (ctx: MethodStmtContext) => { +// const element = new MethodBlockDeclarationElement(ctx, this.document.textDocument); +// this.document.registerNamedElement(element); +// this.document.registerFoldableElement(element); +// this.document.registerSymbolInformation(element); +// this.document.registerScopedElement(element); +// }; + +// exitMethodStmt = (_: MethodStmtContext) => { +// this.document.deregisterScopedElement(); +// }; + +// enterModule = (ctx: ModuleContext) => { +// const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); +// this.document.registerAttributeElement(element); +// this.document.registerScopedElement(element); +// }; + +// exitModule = (_: ModuleContext) => { +// const element = this.document.deregisterAttributeElement() as ModuleElement; +// this.document.registerSymbolInformation(element); +// this.document.deregisterScopedElement(); +// this.document.deregisterAttributeElement(); +// }; + +// enterModuleHeader = (ctx: ModuleHeaderContext) => { +// const element = new FoldableElement(ctx, this.document.textDocument); +// this.document.registerFoldableElement(element); +// }; + +// enterVariableStmt = (ctx: VariableStmtContext) => { +// console.warn("Entered value statement. " + ctx.text); +// const element = new VariableDeclarationsElement(ctx, this.document.textDocument); +// element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); +// }; + +// enterOperatorsStmt = (ctx: OperatorsStmtContext) => { +// const element = new OperatorElement(ctx, this.document.textDocument); +// this.document.registerDiagnosticElement(element); +// }; +// } + +// class VbaErrorListener extends ConsoleErrorListener { +// syntaxError(recognizer: Recognizer, offendingSymbol: T, line: number, charPositionInLine: number, msg: string, e: RecognitionException | undefined): void { +// super.syntaxError(recognizer, offendingSymbol, line, charPositionInLine, msg, e); +// console.error(e); +// if (e) { +// const y = recognizer.getErrorHeader(e); +// console.log(y); +// } +// recognizer.inputStream?.consume(); +// } +// } From e802a4fc0f8d0ad8e8b14cd37868c2f90378b4d9 Mon Sep 17 00:00:00 2001 From: sslinky Date: Fri, 31 May 2024 23:28:07 +0800 Subject: [PATCH 26/61] New ts version broke extensions --- server/src/extensions/stringExtensions.ts | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/server/src/extensions/stringExtensions.ts b/server/src/extensions/stringExtensions.ts index 24caf61..9c43ace 100644 --- a/server/src/extensions/stringExtensions.ts +++ b/server/src/extensions/stringExtensions.ts @@ -1,9 +1,5 @@ -import '.'; - -declare global { - export interface String { - stripQuotes(): string; - } +interface String { + stripQuotes(): string; } String.prototype.stripQuotes = function (): string { From ef2e7bc75182154aa3bc84765a02cf507a93337b Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 14:33:47 +0800 Subject: [PATCH 27/61] Separate name attribute to make it easier to target and add description attribute --- server/src/antlr/vba.g4 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index dfd1204..9758f46 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -76,19 +76,24 @@ classModule // Compare STRINGLITERAL to quoted-identifier proceduralModuleHeader - : endOfLine* ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL + : endOfLine* nameAttr? ; -classModuleHeader: (endOfLine+ classAttr)+ WS?; +classModuleHeader: (endOfLine+ (classAttr | nameAttr))* WS?; // VBA Library Projects are allowed to have GoobalNamespace and creatable as true. classAttr - : ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL + : ATTRIBUTE WS? VB_DESCRIPTION WS? EQ WS? STRINGLITERAL | ATTRIBUTE WS? VB_GLOBALNAMESPACE WS? EQ WS? booleanLiteralIdentifier | ATTRIBUTE WS? VB_CREATABLE WS? EQ WS? booleanLiteralIdentifier | ATTRIBUTE WS? VB_PREDECLAREDID WS? EQ WS? booleanLiteralIdentifier | ATTRIBUTE WS? VB_EXPOSED WS? EQ WS? booleanLiteralIdentifier | ATTRIBUTE WS? VB_CUSTOMIZABLE WS? EQ WS? booleanLiteralIdentifier ; + +nameAttr + : ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL + ; + //--------------------------------------------------------------------------------------- // 5.1 Module Body Structure // Everything from here down is user generated code. From 572977b8908e906fcc99428de1f2a802a6b850bf Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 14:35:18 +0800 Subject: [PATCH 28/61] Upgrade packages and typescript --- package-lock.json | 180 +++++++++++++++++++++++++--------------------- package.json | 5 +- tsconfig.json | 10 +-- 3 files changed, 107 insertions(+), 88 deletions(-) diff --git a/package-lock.json b/package-lock.json index 7481252..c852f6f 100644 --- a/package-lock.json +++ b/package-lock.json @@ -19,12 +19,39 @@ "eslint": "^8.13.0", "js-yaml": "^4.1.0", "mocha": "^9.2.1", - "typescript": "^4.7.2" + "typescript": "^5.4.5" }, "engines": { "vscode": "^1.63.0" } }, + "../../../Users/svand/Downloads/antlr4ng-3.0.4": { + "name": "antlr4ng", + "version": "3.0.4", + "extraneous": true, + "license": "BSD-3-Clause", + "devDependencies": { + "@mike-lischke/antlr-tgen": "1.0.8", + "@types/jest": "29.5.12", + "@types/node": "20.11.28", + "@types/unicode-properties": "1.3.2", + "@typescript-eslint/eslint-plugin": "7.2.0", + "@typescript-eslint/parser": "7.2.0", + "esbuild": "0.20.2", + "eslint": "8.57.0", + "eslint-plugin-import": "2.29.1", + "eslint-plugin-jsdoc": "48.2.1", + "eslint-plugin-prefer-arrow": "1.2.3", + "jest": "29.7.0", + "ts-jest": "29.1.2", + "ts-node": "10.9.2", + "typescript": "5.4.2", + "unicode-properties": "1.4.1" + }, + "peerDependencies": { + "antlr4ng-cli": "^2.0.0" + } + }, "node_modules/@eslint/eslintrc": { "version": "1.2.1", "resolved": "https://registry.npmjs.org/@eslint/eslintrc/-/eslintrc-1.2.1.tgz", @@ -1408,18 +1435,6 @@ "url": "https://github.com/sponsors/sindresorhus" } }, - "node_modules/lru-cache": { - "version": "6.0.0", - "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-6.0.0.tgz", - "integrity": "sha512-Jo6dJ04CmSjuznwJSS3pUeWmd/H0ffTlkXXgwZi+eq1UCmqQwCh+eLsYOYCwY991i2Fah4h1BEMCx4qThGbsiA==", - "dev": true, - "dependencies": { - "yallist": "^4.0.0" - }, - "engines": { - "node": ">=10" - } - }, "node_modules/merge2": { "version": "1.4.1", "resolved": "https://registry.npmjs.org/merge2/-/merge2-1.4.1.tgz", @@ -1443,10 +1458,11 @@ } }, "node_modules/minimatch": { - "version": "3.0.4", - "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz", - "integrity": "sha512-yJHVQEhyqPLUTgt9B83PXu6W3rx4MvvHvSUvToogpwoGDOUQ+yDrR0HRot+yOCdCO7u4hX3pWft6kWBBcqh0UA==", + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.1.2.tgz", + "integrity": "sha512-J7p63hRiAjw1NDEww1W7i37+ByIrOWO5XQQAzZ3VOcL0PNybwpfmV/N05zFAzwQ9USyEcX6t3UO+K5aqBQOIHw==", "dev": true, + "license": "ISC", "dependencies": { "brace-expansion": "^1.1.7" }, @@ -1455,10 +1471,11 @@ } }, "node_modules/mocha": { - "version": "9.2.1", - "resolved": "https://registry.npmjs.org/mocha/-/mocha-9.2.1.tgz", - "integrity": "sha512-T7uscqjJVS46Pq1XDXyo9Uvey9gd3huT/DD9cYBb4K2Xc/vbKRPUWK067bxDQRK0yIz6Jxk73IrnimvASzBNAQ==", + "version": "9.2.2", + "resolved": "https://registry.npmjs.org/mocha/-/mocha-9.2.2.tgz", + "integrity": "sha512-L6XC3EdwT6YrIk0yXpavvLkn8h+EU+Y5UcCHKECyMbdUIxyMuZj4bX4U9e1nvnvUUvQVsV2VHQr5zLdcUkhW/g==", "dev": true, + "license": "MIT", "dependencies": { "@ungap/promise-all-settled": "1.1.2", "ansi-colors": "4.1.1", @@ -1473,9 +1490,9 @@ "he": "1.2.0", "js-yaml": "4.1.0", "log-symbols": "4.1.0", - "minimatch": "3.0.4", + "minimatch": "4.2.1", "ms": "2.1.3", - "nanoid": "3.2.0", + "nanoid": "3.3.1", "serialize-javascript": "6.0.0", "strip-json-comments": "3.1.1", "supports-color": "8.1.1", @@ -1497,6 +1514,19 @@ "url": "https://opencollective.com/mochajs" } }, + "node_modules/mocha/node_modules/minimatch": { + "version": "4.2.1", + "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-4.2.1.tgz", + "integrity": "sha512-9Uq1ChtSZO+Mxa/CL1eGizn2vRn3MlLgzhT0Iz8zaY8NdvxvB0d5QdPFmCKf7JKA9Lerx5vRrnwO03jsSfGG9g==", + "dev": true, + "license": "ISC", + "dependencies": { + "brace-expansion": "^1.1.7" + }, + "engines": { + "node": ">=10" + } + }, "node_modules/mocha/node_modules/ms": { "version": "2.1.3", "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.3.tgz", @@ -1525,10 +1555,11 @@ "dev": true }, "node_modules/nanoid": { - "version": "3.2.0", - "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.2.0.tgz", - "integrity": "sha512-fmsZYa9lpn69Ad5eDn7FMcnnSR+8R34W9qJEijxYhTbfOWzr22n1QxCMzXLK+ODyW2973V3Fux959iQoUxzUIA==", + "version": "3.3.1", + "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.3.1.tgz", + "integrity": "sha512-n6Vs/3KGyxPQd6uO0eH4Bv0ojGSUvuLlIHtC3Y0kEO23YRge8H9x1GCzLn28YX0H66pMkxuaeESFq4tKISKwdw==", "dev": true, + "license": "MIT", "bin": { "nanoid": "bin/nanoid.cjs" }, @@ -1825,13 +1856,11 @@ ] }, "node_modules/semver": { - "version": "7.3.7", - "resolved": "https://registry.npmjs.org/semver/-/semver-7.3.7.tgz", - "integrity": "sha512-QlYTucUYOews+WeEujDoEGziz4K6c47V/Bd+LjSSYcA94p+DmINdf7ncaUinThfvZyu13lN9OY1XDxt8C0Tw0g==", + "version": "7.6.2", + "resolved": "https://registry.npmjs.org/semver/-/semver-7.6.2.tgz", + "integrity": "sha512-FNAIBWCx9qcRhoHcgcJ0gvU7SN1lYU2ZXuSfl04bSC5OpvDHFyJCjdNHomPXxjQlCBU67YW64PzY7/VIEH7F2w==", "dev": true, - "dependencies": { - "lru-cache": "^6.0.0" - }, + "license": "ISC", "bin": { "semver": "bin/semver.js" }, @@ -1992,16 +2021,17 @@ } }, "node_modules/typescript": { - "version": "4.7.2", - "resolved": "https://registry.npmjs.org/typescript/-/typescript-4.7.2.tgz", - "integrity": "sha512-Mamb1iX2FDUpcTRzltPxgWMKy3fhg0TN378ylbktPGPK/99KbDtMQ4W1hwgsbPAsG3a0xKa1vmw4VKZQbkvz5A==", + "version": "5.4.5", + "resolved": "https://registry.npmjs.org/typescript/-/typescript-5.4.5.tgz", + "integrity": "sha512-vcI4UpRgg81oIRUFwR0WSIHKt11nJ7SAVlYNIu+QpqeyXP+gpQJy/Z4+F0aGxSE4MqwjyXvW/TzgkLAx2AGHwQ==", "dev": true, + "license": "Apache-2.0", "bin": { "tsc": "bin/tsc", "tsserver": "bin/tsserver" }, "engines": { - "node": ">=4.2.0" + "node": ">=14.17" } }, "node_modules/uri-js": { @@ -2035,10 +2065,11 @@ } }, "node_modules/word-wrap": { - "version": "1.2.3", - "resolved": "https://registry.npmjs.org/word-wrap/-/word-wrap-1.2.3.tgz", - "integrity": "sha512-Hz/mrNwitNRh/HUAtM/VT/5VH+ygD6DV7mYKZAtHOrbs8U7lvPS6xf7EJKMF0uW1KJCl0H701g3ZGus+muE5vQ==", + "version": "1.2.5", + "resolved": "https://registry.npmjs.org/word-wrap/-/word-wrap-1.2.5.tgz", + "integrity": "sha512-BN22B5eaMMI9UMtjrGd5g5eCYPpCPDUy0FJXbYsaT5zYxjFOckS53SQDE3pWkVoWpHXVb3BrYcEN4Twa55B5cA==", "dev": true, + "license": "MIT", "engines": { "node": ">=0.10.0" } @@ -2081,12 +2112,6 @@ "node": ">=10" } }, - "node_modules/yallist": { - "version": "4.0.0", - "resolved": "https://registry.npmjs.org/yallist/-/yallist-4.0.0.tgz", - "integrity": "sha512-3wdGidZyq5PB084XLES5TpOSRA3wjXAlIWMhum2kRcv/41Sn2emQ0dycQW4uZXLejwKvg6EsvbdlVL+FYEct7A==", - "dev": true - }, "node_modules/yargs": { "version": "16.2.0", "resolved": "https://registry.npmjs.org/yargs/-/yargs-16.2.0.tgz", @@ -3128,15 +3153,6 @@ "is-unicode-supported": "^0.1.0" } }, - "lru-cache": { - "version": "6.0.0", - "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-6.0.0.tgz", - "integrity": "sha512-Jo6dJ04CmSjuznwJSS3pUeWmd/H0ffTlkXXgwZi+eq1UCmqQwCh+eLsYOYCwY991i2Fah4h1BEMCx4qThGbsiA==", - "dev": true, - "requires": { - "yallist": "^4.0.0" - } - }, "merge2": { "version": "1.4.1", "resolved": "https://registry.npmjs.org/merge2/-/merge2-1.4.1.tgz", @@ -3154,18 +3170,18 @@ } }, "minimatch": { - "version": "3.0.4", - "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz", - "integrity": "sha512-yJHVQEhyqPLUTgt9B83PXu6W3rx4MvvHvSUvToogpwoGDOUQ+yDrR0HRot+yOCdCO7u4hX3pWft6kWBBcqh0UA==", + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.1.2.tgz", + "integrity": "sha512-J7p63hRiAjw1NDEww1W7i37+ByIrOWO5XQQAzZ3VOcL0PNybwpfmV/N05zFAzwQ9USyEcX6t3UO+K5aqBQOIHw==", "dev": true, "requires": { "brace-expansion": "^1.1.7" } }, "mocha": { - "version": "9.2.1", - "resolved": "https://registry.npmjs.org/mocha/-/mocha-9.2.1.tgz", - "integrity": "sha512-T7uscqjJVS46Pq1XDXyo9Uvey9gd3huT/DD9cYBb4K2Xc/vbKRPUWK067bxDQRK0yIz6Jxk73IrnimvASzBNAQ==", + "version": "9.2.2", + "resolved": "https://registry.npmjs.org/mocha/-/mocha-9.2.2.tgz", + "integrity": "sha512-L6XC3EdwT6YrIk0yXpavvLkn8h+EU+Y5UcCHKECyMbdUIxyMuZj4bX4U9e1nvnvUUvQVsV2VHQr5zLdcUkhW/g==", "dev": true, "requires": { "@ungap/promise-all-settled": "1.1.2", @@ -3181,9 +3197,9 @@ "he": "1.2.0", "js-yaml": "4.1.0", "log-symbols": "4.1.0", - "minimatch": "3.0.4", + "minimatch": "4.2.1", "ms": "2.1.3", - "nanoid": "3.2.0", + "nanoid": "3.3.1", "serialize-javascript": "6.0.0", "strip-json-comments": "3.1.1", "supports-color": "8.1.1", @@ -3194,6 +3210,15 @@ "yargs-unparser": "2.0.0" }, "dependencies": { + "minimatch": { + "version": "4.2.1", + "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-4.2.1.tgz", + "integrity": "sha512-9Uq1ChtSZO+Mxa/CL1eGizn2vRn3MlLgzhT0Iz8zaY8NdvxvB0d5QdPFmCKf7JKA9Lerx5vRrnwO03jsSfGG9g==", + "dev": true, + "requires": { + "brace-expansion": "^1.1.7" + } + }, "ms": { "version": "2.1.3", "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.3.tgz", @@ -3218,9 +3243,9 @@ "dev": true }, "nanoid": { - "version": "3.2.0", - "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.2.0.tgz", - "integrity": "sha512-fmsZYa9lpn69Ad5eDn7FMcnnSR+8R34W9qJEijxYhTbfOWzr22n1QxCMzXLK+ODyW2973V3Fux959iQoUxzUIA==", + "version": "3.3.1", + "resolved": "https://registry.npmjs.org/nanoid/-/nanoid-3.3.1.tgz", + "integrity": "sha512-n6Vs/3KGyxPQd6uO0eH4Bv0ojGSUvuLlIHtC3Y0kEO23YRge8H9x1GCzLn28YX0H66pMkxuaeESFq4tKISKwdw==", "dev": true }, "natural-compare": { @@ -3400,13 +3425,10 @@ "dev": true }, "semver": { - "version": "7.3.7", - "resolved": "https://registry.npmjs.org/semver/-/semver-7.3.7.tgz", - "integrity": "sha512-QlYTucUYOews+WeEujDoEGziz4K6c47V/Bd+LjSSYcA94p+DmINdf7ncaUinThfvZyu13lN9OY1XDxt8C0Tw0g==", - "dev": true, - "requires": { - "lru-cache": "^6.0.0" - } + "version": "7.6.2", + "resolved": "https://registry.npmjs.org/semver/-/semver-7.6.2.tgz", + "integrity": "sha512-FNAIBWCx9qcRhoHcgcJ0gvU7SN1lYU2ZXuSfl04bSC5OpvDHFyJCjdNHomPXxjQlCBU67YW64PzY7/VIEH7F2w==", + "dev": true }, "serialize-javascript": { "version": "6.0.0", @@ -3519,9 +3541,9 @@ "dev": true }, "typescript": { - "version": "4.7.2", - "resolved": "https://registry.npmjs.org/typescript/-/typescript-4.7.2.tgz", - "integrity": "sha512-Mamb1iX2FDUpcTRzltPxgWMKy3fhg0TN378ylbktPGPK/99KbDtMQ4W1hwgsbPAsG3a0xKa1vmw4VKZQbkvz5A==", + "version": "5.4.5", + "resolved": "https://registry.npmjs.org/typescript/-/typescript-5.4.5.tgz", + "integrity": "sha512-vcI4UpRgg81oIRUFwR0WSIHKt11nJ7SAVlYNIu+QpqeyXP+gpQJy/Z4+F0aGxSE4MqwjyXvW/TzgkLAx2AGHwQ==", "dev": true }, "uri-js": { @@ -3549,9 +3571,9 @@ } }, "word-wrap": { - "version": "1.2.3", - "resolved": "https://registry.npmjs.org/word-wrap/-/word-wrap-1.2.3.tgz", - "integrity": "sha512-Hz/mrNwitNRh/HUAtM/VT/5VH+ygD6DV7mYKZAtHOrbs8U7lvPS6xf7EJKMF0uW1KJCl0H701g3ZGus+muE5vQ==", + "version": "1.2.5", + "resolved": "https://registry.npmjs.org/word-wrap/-/word-wrap-1.2.5.tgz", + "integrity": "sha512-BN22B5eaMMI9UMtjrGd5g5eCYPpCPDUy0FJXbYsaT5zYxjFOckS53SQDE3pWkVoWpHXVb3BrYcEN4Twa55B5cA==", "dev": true }, "workerpool": { @@ -3583,12 +3605,6 @@ "integrity": "sha512-PlVX4Y0lDTN6E2V4ES2tEdyvXkeKzxa8c/vo0pxPr/TqbztddTP0yn7zZylIyiAuxerqj0Q5GhpJ1YJCP8LaZQ==", "dev": true }, - "yallist": { - "version": "4.0.0", - "resolved": "https://registry.npmjs.org/yallist/-/yallist-4.0.0.tgz", - "integrity": "sha512-3wdGidZyq5PB084XLES5TpOSRA3wjXAlIWMhum2kRcv/41Sn2emQ0dycQW4uZXLejwKvg6EsvbdlVL+FYEct7A==", - "dev": true - }, "yargs": { "version": "16.2.0", "resolved": "https://registry.npmjs.org/yargs/-/yargs-16.2.0.tgz", diff --git a/package.json b/package.json index edd39d6..f71c939 100644 --- a/package.json +++ b/package.json @@ -1,5 +1,6 @@ { "name": "vba-lsp", + "type": "module", "displayName": "VBA Pro", "description": "A VBA extension for VSCode with Language Server support", "icon": "images/vba-lsp-icon.png", @@ -90,7 +91,7 @@ "postinstall": "cd client && npm install && cd ../server && npm install && cd ..", "test": "sh ./scripts/e2e.sh", "textMate": "npx js-yaml client/src/syntaxes/vba.tmLanguage.yaml > client/out/vba.tmLanguage.json", - "antlr4ts": "antlr4ng -Dlanguage=TypeScript -visitor ./server/src/antlr/vba.g4 -o ./server/src/antlr/out/" + "antlr4ng": "antlr4ng -Dlanguage=TypeScript -visitor ./server/src/antlr/vba.g4 -o ./server/src/antlr/out/" }, "devDependencies": { "@types/mocha": "^9.1.0", @@ -102,6 +103,6 @@ "eslint": "^8.13.0", "js-yaml": "^4.1.0", "mocha": "^9.2.1", - "typescript": "^4.7.2" + "typescript": "^5.4.5" } } diff --git a/tsconfig.json b/tsconfig.json index b61abe6..b6646ee 100644 --- a/tsconfig.json +++ b/tsconfig.json @@ -1,11 +1,13 @@ { "compilerOptions": { - "module": "commonjs", - "target": "es2020", - "lib": ["es2020"], + "module": "NodeNext", + "target": "ESNext", + "moduleResolution": "NodeNext", + "lib": ["ESNext", "DOM"], "outDir": "out", "rootDir": "src", - "sourceMap": true + "sourceMap": true, + "forceConsistentCasingInFileNames": true }, "include": [ "src" From 29eb283339977536638c7fcb48908c99954d0aa5 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 14:37:10 +0800 Subject: [PATCH 29/61] Rename property set for clarity --- server/src/antlr/vba.g4 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 9758f46..6e85ed6 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -363,7 +363,7 @@ procedureDeclaration : subroutineDeclaration | functionDeclaration | propertyGetDeclaration - | propertyLhsDeclaration + | propertySetDeclaration ; // 5.3.1 Procedure Declarations @@ -389,7 +389,7 @@ propertyGetDeclaration procedureBody? endLabel? endOfStatement+ END wsc PROPERTY procedureTail?; -propertyLhsDeclaration +propertySetDeclaration : (procedureScope wsc)? ( (initialStatic wsc)? PROPERTY wsc (LET | SET) wsc subroutineName wsc? propertyParameters | PROPERTY wsc (LET | SET) wsc subroutineName propertyParameters wsc? trailingStatic) From b6dc2c443c26a3d3b983e443ea216f52defd77fd Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 14:42:35 +0800 Subject: [PATCH 30/61] Upgrade to antlr4ng. Everything is broken! --- server/src/capabilities/semanticTokens.ts | 2 +- server/src/extensions/parserExtensions.ts | 69 ++- server/src/project/document.ts | 34 +- server/src/project/elements/base.ts | 19 +- server/src/project/elements/flow.ts | 35 +- server/src/project/elements/memory.ts | 433 ++++++++++++------- server/src/project/elements/module.ts | 168 +++++-- server/src/project/elements/operator.ts | 23 +- server/src/project/elements/special.ts | 2 +- server/src/project/parser/vbaSyntaxParser.ts | 41 +- server/src/server.ts | 1 - 11 files changed, 535 insertions(+), 292 deletions(-) diff --git a/server/src/capabilities/semanticTokens.ts b/server/src/capabilities/semanticTokens.ts index 4bca659..5725e33 100644 --- a/server/src/capabilities/semanticTokens.ts +++ b/server/src/capabilities/semanticTokens.ts @@ -49,7 +49,7 @@ export class SemanticToken { element, element.identifier.range.start.line, element.identifier.range.start.character, - element.identifier.context.text.length, + element.identifier.context.getText().length, element.tokenType, element.tokenModifiers ); diff --git a/server/src/extensions/parserExtensions.ts b/server/src/extensions/parserExtensions.ts index 6b4e305..1f6052e 100644 --- a/server/src/extensions/parserExtensions.ts +++ b/server/src/extensions/parserExtensions.ts @@ -1,5 +1,4 @@ import { Range, SymbolKind } from 'vscode-languageserver'; -import { BaseTypeContext, ComplexTypeContext } from '../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; // import { ParserRuleContext } from 'antlr4ts'; @@ -21,44 +20,44 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; // }; -declare module '../antlr/out/vbaParser' { - export interface BaseTypeContext { - toSymbolKind(): SymbolKind; - } +// declare module '../antlr/out/vbaParser' { +// export interface BaseTypeContext { +// toSymbolKind(): SymbolKind; +// } - export interface ComplexTypeContext { - toSymbolKind(): SymbolKind; - } -} +// export interface ComplexTypeContext { +// toSymbolKind(): SymbolKind; +// } +// } -BaseTypeContext.prototype.toSymbolKind = function (): SymbolKind { - return toSymbolKind(this); -}; +// BaseTypeContext.prototype.toSymbolKind = function (): SymbolKind { +// return toSymbolKind(this); +// }; -ComplexTypeContext.prototype.toSymbolKind = function (): SymbolKind { - return toSymbolKind(this); -}; +// ComplexTypeContext.prototype.toSymbolKind = function (): SymbolKind { +// return toSymbolKind(this); +// }; -function toSymbolKind(context: BaseTypeContext | ComplexTypeContext): SymbolKind { - switch (context.text.toLocaleLowerCase()) { - case 'boolean': - return SymbolKind.Boolean; - case 'byte': - case 'string': - return SymbolKind.String; - case 'double': - case 'currency': - case 'integer': - case 'long': - case 'longPtr': - case 'longLong': - return SymbolKind.Number; - case 'object': - return SymbolKind.Object; - default: - return SymbolKind.Class; - } -} +// function toSymbolKind(context: BaseTypeContext | ComplexTypeContext): SymbolKind { +// switch (context.text.toLocaleLowerCase()) { +// case 'boolean': +// return SymbolKind.Boolean; +// case 'byte': +// case 'string': +// return SymbolKind.String; +// case 'double': +// case 'currency': +// case 'integer': +// case 'long': +// case 'longPtr': +// case 'longLong': +// return SymbolKind.Number; +// case 'object': +// return SymbolKind.Object; +// default: +// return SymbolKind.Class; +// } +// } /** * const File: 1; diff --git a/server/src/project/document.ts b/server/src/project/document.ts index 76a786f..ee1f84d 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -1,7 +1,7 @@ import { CancellationToken, Diagnostic, LSPErrorCodes, PublishDiagnosticsParams, ResponseError, SemanticTokens, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { Workspace } from './workspace'; import { FoldableElement } from './elements/special'; -import { BaseSyntaxElement, HasAttribute, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation } from './elements/base'; +import { BaseSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, ScopeElement } from './elements/base'; import { Range, TextDocument } from 'vscode-languageserver-textdocument'; import { SyntaxParser } from './parser/vbaSyntaxParser'; import { FoldingRange } from '../capabilities/folding'; @@ -10,18 +10,18 @@ import { sleep } from '../utils/helpers'; export abstract class BaseProjectDocument { + readonly name: string; readonly workspace: Workspace; readonly textDocument: TextDocument; - readonly name: string; + protected _hasDiagnosticElements: HasDiagnosticCapability[] = []; protected _unhandledNamedElements: [] = []; protected _publicScopeDeclarations: Map = new Map(); protected _documentScopeDeclarations: Map> = new Map(); - protected _hasDiagnosticElements: HasDiagnosticCapability[] = []; protected _diagnostics: Diagnostic[] = []; - protected _elementParents: BaseSyntaxElement[] = []; - protected _attributeElements: HasAttribute[] = []; + protected _elementParents: ScopeElement[] = []; + // protected _attributeElements: HasAttribute[] = []; protected _foldableElements: FoldingRange[] = []; protected _symbolInformations: SymbolInformation[] = []; protected _semanticTokens: SemanticTokensManager = new SemanticTokensManager(); @@ -33,10 +33,14 @@ export abstract class BaseProjectDocument { return this._isBusy; } - get activeAttributeElement() { - return this._attributeElements?.at(-1); + get currentScopeElement() { + return this._elementParents[-1]; } + // get activeAttributeElement() { + // return this._attributeElements?.at(-1); + // } + constructor(workspace: Workspace, name: string, document: TextDocument) { this.textDocument = document; this.workspace = workspace; @@ -121,10 +125,10 @@ export abstract class BaseProjectDocument { * @param element the element to register. * @returns nothing of interest. */ - registerAttributeElement = (element: HasAttribute) => { - this._attributeElements.push(element); - return this; - }; + // registerAttributeElement = (element: HasAttribute) => { + // this._attributeElements.push(element); + // return this; + // }; /** * Pops an element from the attribute elements stack. @@ -133,9 +137,9 @@ export abstract class BaseProjectDocument { * @param element the element to register. * @returns the element at the end of the stack. */ - deregisterAttributeElement = () => { - return this._attributeElements.pop(); - }; + // deregisterAttributeElement = () => { + // return this._attributeElements.pop(); + // }; registerFoldableElement = (element: FoldableElement) => { this._foldableElements.push(new FoldingRange(element)); @@ -153,7 +157,7 @@ export abstract class BaseProjectDocument { * @param element the element to register. * @returns this for chaining. */ - registerScopedElement(element: BaseSyntaxElement) { + registerScopedElement(element: ScopeElement) { this._elementParents.push(element); return this; } diff --git a/server/src/project/elements/base.ts b/server/src/project/elements/base.ts index 8f46396..cdec41b 100644 --- a/server/src/project/elements/base.ts +++ b/server/src/project/elements/base.ts @@ -1,9 +1,8 @@ -import { ParserRuleContext } from 'antlr4ts'; +import { ParserRuleContext } from 'antlr4ng'; import { Diagnostic, Range, SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { Position, TextDocument } from 'vscode-languageserver-textdocument'; import { FoldingRangeKind } from '../../capabilities/folding'; import { IdentifierElement } from './memory'; -import { AttributeStmtContext } from '../../antlr/out/vbaParser'; import '../../extensions/parserExtensions'; export interface ContextOptionalSyntaxElement { @@ -26,10 +25,6 @@ export interface HasDiagnosticCapability { evaluateDiagnostics(): void; } -export interface HasAttribute { - processAttribute(context: AttributeStmtContext): void; -} - export interface NamedSyntaxElement extends SyntaxElement { get name(): string; } @@ -58,6 +53,10 @@ export interface FoldingRangeElement { foldingRangeKind?: FoldingRangeKind; } +export interface ScopeElement { + declaredNames: Map; +} + export abstract class BaseSyntaxElement implements ContextOptionalSyntaxElement { protected document: TextDocument; @@ -65,7 +64,7 @@ export abstract class BaseSyntaxElement implements ContextOptionalSyntaxElement parent?: ContextOptionalSyntaxElement; context?: ParserRuleContext; - get text(): string { return this.context?.text ?? ''; } + get text(): string { return this.context?.getText() ?? ''; } get uri(): string { return this.document.uri; } constructor(context: ParserRuleContext | undefined, document: TextDocument) { @@ -91,8 +90,8 @@ export abstract class BaseSyntaxElement implements ContextOptionalSyntaxElement return; } - const startIndex = this.context.start.startIndex; - const stopIndex = this.context.stop?.stopIndex ?? startIndex; + const startIndex = this.context?.start?.start ?? 0; + const stopIndex = this.context.stop?.stop ?? startIndex; return Range.create( this.document.positionAt(startIndex), this.document.positionAt(stopIndex + 1) @@ -107,4 +106,4 @@ export abstract class BaseContextSyntaxElement extends BaseSyntaxElement { constructor(ctx: ParserRuleContext, doc: TextDocument) { super(ctx, doc); } -} \ No newline at end of file +} diff --git a/server/src/project/elements/flow.ts b/server/src/project/elements/flow.ts index ef59874..48b9451 100644 --- a/server/src/project/elements/flow.ts +++ b/server/src/project/elements/flow.ts @@ -1,7 +1,6 @@ -import { ParserRuleContext } from 'antlr4ts'; +import { ParserRuleContext } from 'antlr4ng'; import { BaseContextSyntaxElement, HasDiagnosticCapability } from './base'; import { TextDocument } from 'vscode-languageserver-textdocument'; -import { ValueStmtContext, WhileWendStmtContext } from '../../antlr/out/vbaParser'; import { Diagnostic } from 'vscode-languageserver'; import { WhileWendDeprecatedDiagnostic } from '../../capabilities/diagnostics'; @@ -13,22 +12,22 @@ class BaseLoopElement extends BaseContextSyntaxElement { } -export class WhileWendLoopElement extends BaseLoopElement implements HasDiagnosticCapability { - diagnostics: Diagnostic[] = []; - valueStatement: ValueStatementElement; +// export class WhileWendLoopElement extends BaseLoopElement implements HasDiagnosticCapability { +// diagnostics: Diagnostic[] = []; +// valueStatement: ValueStatementElement; - constructor(context: WhileWendStmtContext, document: TextDocument) { - super(context, document); - this.valueStatement = new ValueStatementElement(context.valueStmt(), document); - } +// constructor(context: WhileWendStmtContext, document: TextDocument) { +// super(context, document); +// this.valueStatement = new ValueStatementElement(context.valueStmt(), document); +// } - evaluateDiagnostics(): void { - this.diagnostics.push(new WhileWendDeprecatedDiagnostic(this.valueStatement.range)); - } -} +// evaluateDiagnostics(): void { +// this.diagnostics.push(new WhileWendDeprecatedDiagnostic(this.valueStatement.range)); +// } +// } -class ValueStatementElement extends BaseContextSyntaxElement { - constructor(context: ValueStmtContext, document: TextDocument) { - super(context, document); - } -} \ No newline at end of file +// class ValueStatementElement extends BaseContextSyntaxElement { +// constructor(context: ValueStmtContext, document: TextDocument) { +// super(context, document); +// } +// } \ No newline at end of file diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index f5194d7..7f2f2c4 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,12 +1,13 @@ -import { AmbiguousIdentifierContext, AsTypeClauseContext, ConstStmtContext, ConstSubStmtContext, EnumerationStmtContext, EnumerationStmt_ConstantContext, MethodStmtContext, TypeStmtContext, VariableStmtContext, VariableSubStmtContext } from '../../antlr/out/vbaParser'; +import { AmbiguousIdentifierContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, SubroutineDeclarationContext } from '../../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; -import { BaseContextSyntaxElement, BaseSyntaxElement, HasSemanticToken, HasSymbolInformation } from './base'; +import { BaseContextSyntaxElement, BaseSyntaxElement, HasSemanticToken, HasSymbolInformation, ScopeElement } from './base'; import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { FoldableElement } from './special'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import '../../extensions/parserExtensions'; +import { VbaClassDocument, VbaModuleDocument } from '../document'; export class IdentifierElement extends BaseContextSyntaxElement { @@ -15,197 +16,339 @@ export class IdentifierElement extends BaseContextSyntaxElement { } } +export abstract class DeclarationElement extends FoldableElement implements ScopeElement { + abstract identifier: IdentifierElement; + abstract declaredNames: Map; -abstract class BaseEnumElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { - identifier: IdentifierElement; - tokenModifiers: SemanticTokenModifiers[] = []; - abstract tokenType: SemanticTokenTypes; - abstract symbolKind: SymbolKind; - - constructor(context: EnumerationStmtContext | EnumerationStmt_ConstantContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); - this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); } - - get name(): string { return this.identifier.text; } - get symbolInformation(): SymbolInformation { - return SymbolInformationFactory.create( - this, this.symbolKind - ); + get name(): string { + throw new Error('Method not implemented.'); } -} - + static create(context: ProcedureDeclarationContext, document: VbaClassDocument | VbaModuleDocument) { + let methodContext: SubroutineDeclarationContext | FunctionDeclarationContext | PropertyGetDeclarationContext | null; + methodContext = context.subroutineDeclaration(); + if (methodContext) { + return new SubDeclarationElement(context, document.textDocument, methodContext); + } -export class EnumBlockDeclarationElement extends BaseEnumElement { - tokenType: SemanticTokenTypes; - tokenModifiers: SemanticTokenModifiers[] = []; - symbolKind: SymbolKind; + methodContext = context.functionDeclaration(); + if (methodContext) { + return new FunctionDeclarationElement(context, document.textDocument, methodContext); + } - constructor(context: EnumerationStmtContext, document: TextDocument) { - super(context, document); - this.tokenType = SemanticTokenTypes.enum; - this.symbolKind = SymbolKind.Enum; + const propertyDeclaration = new PropertyDeclarationElement(context, document.textDocument); + const predeclaredElement = document.currentScopeElement.declaredNames.get(propertyDeclaration.identifier.text); + if (predeclaredElement && isPropertyDeclarationElement(predeclaredElement)) { + predeclaredElement.addPropertyDeclaration(context, document.textDocument); + return predeclaredElement; + } + return propertyDeclaration; } -} - -export class EnumMemberDeclarationElement extends BaseEnumElement { - tokenType: SemanticTokenTypes; - tokenModifiers: SemanticTokenModifiers[] = []; - symbolKind: SymbolKind; - - constructor(context: EnumerationStmt_ConstantContext, document: TextDocument) { - super(context, document); - this.tokenType = SemanticTokenTypes.enumMember; - this.symbolKind = SymbolKind.EnumMember; - } } -abstract class BaseMethodElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { +export class SubDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; - tokenModifiers: SemanticTokenModifiers[] = []; - abstract tokenType: SemanticTokenTypes; - abstract symbolKind: SymbolKind; + symbolInformation: SymbolInformation; + declaredNames: Map = new Map(); - constructor(context: MethodStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: SubroutineDeclarationContext) { super(context, document); - this.identifier = new IdentifierElement(context.methodSignatureStmt().ambiguousIdentifier(), document); - } - get name(): string { return this.identifier.text; } - get symbolInformation(): SymbolInformation { - return SymbolInformationFactory.create( - this, this.symbolKind + const identifierContext = methodContext.subroutineName()!.ambiguousIdentifier()!; + this.identifier = new IdentifierElement(identifierContext, document); + this.symbolInformation = SymbolInformation.create( + this.identifier.text, + SymbolKind.Method, + this.range, + this.document.uri ); } } -export class MethodBlockDeclarationElement extends BaseMethodElement { - tokenType: SemanticTokenTypes; - tokenModifiers: SemanticTokenModifiers[] = []; - symbolKind: SymbolKind; +export class FunctionDeclarationElement extends DeclarationElement implements HasSymbolInformation { + identifier: IdentifierElement; + symbolInformation: SymbolInformation; + declaredNames: Map = new Map(); - constructor(context: MethodStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: FunctionDeclarationContext) { super(context, document); - this.tokenType = SemanticTokenTypes.method; - this.symbolKind = SymbolKind.Method; + const identifierContext = methodContext.functionName()!.ambiguousIdentifier()!; + this.identifier = new IdentifierElement(identifierContext, document); + this.symbolInformation = SymbolInformation.create( + this.identifier.text, + SymbolKind.Method, + this.range, + this.document.uri + ); } } -abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntaxElement { - abstract declarations: VariableDeclarationElement[]; +export class PropertyDeclarationElement extends DeclarationElement implements HasSymbolInformation { + identifier: IdentifierElement; + symbolInformation: SymbolInformation; + getDeclarations: PropertyGetDeclarationElement[] = []; + letDeclarations: PropertyLetDeclarationElement[] = []; + setDeclarations: PropertyLetDeclarationElement[] = []; + declaredNames: Map = new Map(); - constructor(context: ConstStmtContext | VariableStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); + this.identifier = this.addPropertyDeclaration(context, document); + this.symbolInformation = SymbolInformation.create( + this.identifier.text, + SymbolKind.Property, + this.range, + this.document.uri + ); } -} -export class ConstDeclarationsElement extends BaseVariableDeclarationStatementElement { - declarations: VariableDeclarationElement[] = []; - - constructor(context: ConstStmtContext, document: TextDocument) { - super(context, document); - context.constSubStmt().forEach((element) => - this.declarations.push(new VariableDeclarationElement( - element, document - )) - ); + addPropertyDeclaration(context: ProcedureDeclarationContext, document: TextDocument) { + switch (true) { + case !!context.propertyGetDeclaration(): + // Property Get + this.getDeclarations.push(new PropertyGetDeclarationElement(context, document, context.propertyGetDeclaration()!)); + return this.getDeclarations[0].identifier; + case !!context.propertySetDeclaration()?.LET(): + // Property Let + this.letDeclarations.push(new PropertyLetDeclarationElement(context, document, context.propertySetDeclaration()!)); + return this.letDeclarations[0].identifier; + default: + // Property Set + this.setDeclarations.push(new PropertySetDeclarationElement(context, document, context.propertySetDeclaration()!)); + return this.setDeclarations[0].identifier; + } } } -export class TypeDeclarationElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { - tokenType: SemanticTokenTypes; - tokenModifiers: SemanticTokenModifiers[] = []; +class PropertyGetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; - symbolKind: SymbolKind; + declaredNames: Map = new Map(); - constructor(context: TypeStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument, getContext: PropertyGetDeclarationContext) { super(context, document); - this.symbolKind = SymbolKind.Struct; - this.tokenType = SemanticTokenTypes.struct; - this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); - } - - get name(): string { return this.identifier.text; } - get symbolInformation(): SymbolInformation { - return SymbolInformationFactory.create( - this, this.symbolKind - ); + this.identifier = new IdentifierElement(getContext.functionName()!.ambiguousIdentifier()!, document); } - } -export class VariableDeclarationsElement extends BaseVariableDeclarationStatementElement { - declarations: VariableDeclarationElement[] = []; +class PropertyLetDeclarationElement extends DeclarationElement { + identifier: IdentifierElement; + declaredNames: Map = new Map(); - constructor(context: VariableStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); - context.variableListStmt().variableSubStmt().forEach((element) => - this.declarations.push(new VariableDeclarationElement( - element, document - )) - ); + this.identifier = new IdentifierElement(setContext.subroutineName()!.ambiguousIdentifier()!, document); } } -class VariableDeclarationElement extends BaseContextSyntaxElement implements HasSymbolInformation { +class PropertySetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; - asType: VariableType; - arrayBounds?: ArrayBounds; + declaredNames: Map = new Map(); - constructor(context: ConstSubStmtContext | VariableSubStmtContext, document: TextDocument) { + constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); - this.asType = new VariableType(context.asTypeClause(), document); - this.arrayBounds = ArrayBounds.create(context); - this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); - } - - get name(): string { return this.identifier.text; } - get symbolInformation(): SymbolInformation { - return SymbolInformationFactory.create( - this, this.asType.symbolKind - ); + this.identifier = new IdentifierElement(setContext.subroutineName()!.ambiguousIdentifier()!, document); } } -class VariableType extends BaseSyntaxElement { - typeName: string; - symbolKind: SymbolKind; - - constructor(context: AsTypeClauseContext | undefined, document: TextDocument, isArray?: boolean) { - super(context, document); - this.symbolKind = isArray ? SymbolKind.Array : SymbolKind.Variable; - - // Needs more ternery. - const type = context?.type_()?.baseType() ?? context?.type_()?.complexType(); - this.typeName = type?.text ?? type?.text ?? 'Variant'; - this.symbolKind = type ? type.toSymbolKind() : SymbolKind.Variable; - } +function isPropertyDeclarationElement(element: BaseSyntaxElement): element is PropertyDeclarationElement { + return 'getDeclarations' in element; } -class ArrayBounds { - dimensions: { lower: number, upper: number }[] = []; - - constructor(subStmt: VariableSubStmtContext) { - subStmt.subscripts()?.subscript_().forEach((x) => { - const vals = x.valueStmt(); - this.dimensions.push({ - lower: vals.length === 1 ? 0 : +vals[0].text, - upper: vals.length === 1 ? +vals[0].text : +vals[1].text - }); - }); - } - /** - * Creates an ArrayBounds if the context is a variable and an array. - * @param subStmt a subStmt context for a variable or a constant. - * @returns A new array bounds if the context is an array variable. - */ - static create(subStmt: VariableSubStmtContext | ConstSubStmtContext) { - const hasLparenMethod = (x: any): x is VariableSubStmtContext => 'LPAREN' in x; - if (hasLparenMethod(subStmt) && subStmt.LPAREN()) { - return new ArrayBounds(subStmt); - } - } -} \ No newline at end of file +// abstract class BaseEnumElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { +// identifier: IdentifierElement; +// tokenModifiers: SemanticTokenModifiers[] = []; +// abstract tokenType: SemanticTokenTypes; +// abstract symbolKind: SymbolKind; + +// constructor(context: EnumerationStmtContext | EnumerationStmt_ConstantContext, document: TextDocument) { +// super(context, document); +// this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); +// } + +// get name(): string { return this.identifier.text; } +// get symbolInformation(): SymbolInformation { +// return SymbolInformationFactory.create( +// this, this.symbolKind +// ); +// } + +// } + + +// export class EnumBlockDeclarationElement extends BaseEnumElement { +// tokenType: SemanticTokenTypes; +// tokenModifiers: SemanticTokenModifiers[] = []; +// symbolKind: SymbolKind; + +// constructor(context: EnumerationStmtContext, document: TextDocument) { +// super(context, document); +// this.tokenType = SemanticTokenTypes.enum; +// this.symbolKind = SymbolKind.Enum; +// } +// } + + +// export class EnumMemberDeclarationElement extends BaseEnumElement { +// tokenType: SemanticTokenTypes; +// tokenModifiers: SemanticTokenModifiers[] = []; +// symbolKind: SymbolKind; + +// constructor(context: EnumerationStmt_ConstantContext, document: TextDocument) { +// super(context, document); +// this.tokenType = SemanticTokenTypes.enumMember; +// this.symbolKind = SymbolKind.EnumMember; +// } +// } + +// abstract class BaseMethodElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { +// identifier: IdentifierElement; +// tokenModifiers: SemanticTokenModifiers[] = []; +// abstract tokenType: SemanticTokenTypes; +// abstract symbolKind: SymbolKind; + +// constructor(context: MethodStmtContext, document: TextDocument) { +// super(context, document); +// this.identifier = new IdentifierElement(context.methodSignatureStmt().ambiguousIdentifier(), document); +// } + +// get name(): string { return this.identifier.text; } +// get symbolInformation(): SymbolInformation { +// return SymbolInformationFactory.create( +// this, this.symbolKind +// ); +// } +// } + +// export class MethodBlockDeclarationElement extends BaseMethodElement { +// tokenType: SemanticTokenTypes; +// tokenModifiers: SemanticTokenModifiers[] = []; +// symbolKind: SymbolKind; + +// constructor(context: MethodStmtContext, document: TextDocument) { +// super(context, document); +// this.tokenType = SemanticTokenTypes.method; +// this.symbolKind = SymbolKind.Method; +// } +// } + +// abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntaxElement { +// abstract declarations: VariableDeclarationElement[]; + +// constructor(context: ConstStmtContext | VariableStmtContext, document: TextDocument) { +// super(context, document); +// } +// } + +// export class ConstDeclarationsElement extends BaseVariableDeclarationStatementElement { +// declarations: VariableDeclarationElement[] = []; + +// constructor(context: ConstStmtContext, document: TextDocument) { +// super(context, document); +// context.constSubStmt().forEach((element) => +// this.declarations.push(new VariableDeclarationElement( +// element, document +// )) +// ); +// } +// } + +// export class TypeDeclarationElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { +// tokenType: SemanticTokenTypes; +// tokenModifiers: SemanticTokenModifiers[] = []; +// identifier: IdentifierElement; +// symbolKind: SymbolKind; + +// constructor(context: TypeStmtContext, document: TextDocument) { +// super(context, document); +// this.symbolKind = SymbolKind.Struct; +// this.tokenType = SemanticTokenTypes.struct; +// this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); +// } + +// get name(): string { return this.identifier.text; } +// get symbolInformation(): SymbolInformation { +// return SymbolInformationFactory.create( +// this, this.symbolKind +// ); +// } + +// } + +// export class VariableDeclarationsElement extends BaseVariableDeclarationStatementElement { +// declarations: VariableDeclarationElement[] = []; + +// constructor(context: VariableStmtContext, document: TextDocument) { +// super(context, document); +// context.variableListStmt().variableSubStmt().forEach((element) => +// this.declarations.push(new VariableDeclarationElement( +// element, document +// )) +// ); +// } +// } + +// class VariableDeclarationElement extends BaseContextSyntaxElement implements HasSymbolInformation { +// identifier: IdentifierElement; +// asType: VariableType; +// arrayBounds?: ArrayBounds; + +// constructor(context: ConstSubStmtContext | VariableSubStmtContext, document: TextDocument) { +// super(context, document); +// this.asType = new VariableType(context.asTypeClause(), document); +// this.arrayBounds = ArrayBounds.create(context); +// this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); +// } + +// get name(): string { return this.identifier.text; } +// get symbolInformation(): SymbolInformation { +// return SymbolInformationFactory.create( +// this, this.asType.symbolKind +// ); +// } +// } + +// class VariableType extends BaseSyntaxElement { +// typeName: string; +// symbolKind: SymbolKind; + +// constructor(context: AsTypeClauseContext | undefined, document: TextDocument, isArray?: boolean) { +// super(context, document); +// this.symbolKind = isArray ? SymbolKind.Array : SymbolKind.Variable; + +// // Needs more ternery. +// const type = context?.type_()?.baseType() ?? context?.type_()?.complexType(); +// this.typeName = type?.text ?? type?.text ?? 'Variant'; +// this.symbolKind = type ? type.toSymbolKind() : SymbolKind.Variable; +// } +// } + +// class ArrayBounds { +// dimensions: { lower: number, upper: number }[] = []; + +// constructor(subStmt: VariableSubStmtContext) { +// subStmt.subscripts()?.subscript_().forEach((x) => { +// const vals = x.valueStmt(); +// this.dimensions.push({ +// lower: vals.length === 1 ? 0 : +vals[0].text, +// upper: vals.length === 1 ? +vals[0].text : +vals[1].text +// }); +// }); +// } + +// /** +// * Creates an ArrayBounds if the context is a variable and an array. +// * @param subStmt a subStmt context for a variable or a constant. +// * @returns A new array bounds if the context is an array variable. +// */ +// static create(subStmt: VariableSubStmtContext | ConstSubStmtContext) { +// const hasLparenMethod = (x: any): x is VariableSubStmtContext => 'LPAREN' in x; +// if (hasLparenMethod(subStmt) && subStmt.LPAREN()) { +// return new ArrayBounds(subStmt); +// } +// } +// } \ No newline at end of file diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index ae725d9..cd3b2ce 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -1,21 +1,20 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; -import { Diagnostic, SymbolInformation, SymbolKind } from 'vscode-languageserver'; -import { AttributeStmtContext, ModuleContext, ModuleHeaderContext, ModuleOptionContext } from '../../antlr/out/vbaParser'; - -import { BaseContextSyntaxElement, HasAttribute, HasDiagnosticCapability, HasSymbolInformation } from './base'; +import { Diagnostic, Range, SymbolInformation, SymbolKind } from 'vscode-languageserver'; +import { ClassModuleContext, ProceduralModuleContext } from '../../antlr/out/vbaParser'; +import { BaseContextSyntaxElement, BaseSyntaxElement, HasDiagnosticCapability, HasSymbolInformation, ScopeElement } from './base'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; -import { MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; +import { MissingAttributeDiagnostic, MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; +import '../../extensions/stringExtensions'; -export class ModuleElement extends BaseContextSyntaxElement implements HasSymbolInformation, HasAttribute, HasDiagnosticCapability { - private _hasName = false; - private _name: string; +abstract class BaseModuleElement extends BaseContextSyntaxElement implements HasSymbolInformation, HasDiagnosticCapability { + protected abstract _name: string; symbolKind: SymbolKind; diagnostics: Diagnostic[] = []; + declaredNames: Map = new Map(); - constructor(context: ModuleContext, document: TextDocument, symbolKind: SymbolKind) { + constructor(context: ProceduralModuleContext | ClassModuleContext, document: TextDocument, symbolKind: SymbolKind) { super(context, document); - this._name = "Unknown Module"; this.symbolKind = symbolKind; } @@ -29,50 +28,131 @@ export class ModuleElement extends BaseContextSyntaxElement implements HasSymbol ); } + abstract evaluateDiagnostics(): void; +} + +export class ModuleElement extends BaseModuleElement implements ScopeElement { + protected _name: string; + + constructor(context: ProceduralModuleContext, document: TextDocument) { + super(context, document, SymbolKind.File); + this._name = this._getName(context); + } + evaluateDiagnostics(): void { - const optionExplicitDiagnotic = this._getOptionExplicitDiagnostic(); - if (optionExplicitDiagnotic) { - this.diagnostics.push(optionExplicitDiagnotic); - } + return; } - private _getOptionExplicitDiagnostic(): Diagnostic | undefined { - let optionExplicitFound = false; - const context = this.context as ModuleContext; - const declarations = context.moduleHeader().moduleDeclarations()?.moduleDeclarationsElement(); - - if (declarations) { - for (const declaration of declarations) { - if ((declaration.moduleOption()?.text ?? '') === 'Option Explicit') { - optionExplicitFound = true; - break; - } - } + private _getName(context: ProceduralModuleContext) { + const nameAttribute = context.proceduralModuleHeader()?.nameAttr(); + const name = nameAttribute?.STRINGLITERAL().getText(); + + if (!name) { + this.diagnostics.push(new MissingAttributeDiagnostic( + Range.create(this.range.start, this.range.start), + 'VB_NAME' + )); } - return optionExplicitFound ? undefined : new MissingOptionExplicitDiagnostic( - (new ModuelHeaderElement(context.moduleHeader(), this.document)).range - ); + return name?.stripQuotes() ?? 'Unknown Module'; } +} - processAttribute(context: AttributeStmtContext): void { - if (this._hasName) { - return; - } +export class ClassElement extends BaseModuleElement { + protected _name: string; + + constructor(context: ClassModuleContext, document: TextDocument) { + super(context, document, SymbolKind.Class); + this._name = this._getName(context); + } + + evaluateDiagnostics(): void { + return; + } - const text = context.text; - if (text.startsWith("Attribute VB_Name = ")) { - const unquote = (x: string): string => - x.replace(/^"+|"+$/g, ''); + private _getName(context: ClassModuleContext) { + const nameAttributes = context.classModuleHeader().nameAttr(); - this._name = unquote(text.split("= ")[1]); - this._hasName = true; + if (nameAttributes.length === 0) { + this.diagnostics.push(new MissingAttributeDiagnostic( + Range.create(this.range.start, this.range.start), + 'VB_NAME' + )); + return 'Unknown Class'; } + + const nameAttribute = nameAttributes[0]; + return nameAttribute.STRINGLITERAL().getText().stripQuotes(); } } -class ModuelHeaderElement extends BaseContextSyntaxElement { - constructor(context: ModuleHeaderContext, document: TextDocument) { - super(context, document); - } -} \ No newline at end of file + +// export class ModuleElement2 extends BaseContextSyntaxElement implements HasSymbolInformation, HasAttribute, HasDiagnosticCapability { +// private _hasName = false; +// private _name: string; +// symbolKind: SymbolKind; +// diagnostics: Diagnostic[] = []; + +// constructor(context: ModuleContext, document: TextDocument, symbolKind: SymbolKind) { +// super(context, document); +// this._name = "Unknown Module"; +// this.symbolKind = symbolKind; +// } + +// get name(): string { +// return this._name; +// } + +// get symbolInformation(): SymbolInformation { +// return SymbolInformationFactory.create( +// this, this.symbolKind +// ); +// } + +// evaluateDiagnostics(): void { +// const optionExplicitDiagnotic = this._getOptionExplicitDiagnostic(); +// if (optionExplicitDiagnotic) { +// this.diagnostics.push(optionExplicitDiagnotic); +// } +// } + +// private _getOptionExplicitDiagnostic(): Diagnostic | undefined { +// let optionExplicitFound = false; +// const context = this.context as ModuleContext; +// const declarations = context.moduleHeader().moduleDeclarations()?.moduleDeclarationsElement(); + +// if (declarations) { +// for (const declaration of declarations) { +// if ((declaration.moduleOption()?.text ?? '') === 'Option Explicit') { +// optionExplicitFound = true; +// break; +// } +// } +// } + +// return optionExplicitFound ? undefined : new MissingOptionExplicitDiagnostic( +// (new ModuelHeaderElement(context.moduleHeader(), this.document)).range +// ); +// } + +// processAttribute(context: AttributeStmtContext): void { +// if (this._hasName) { +// return; +// } + +// const text = context.text; +// if (text.startsWith("Attribute VB_Name = ")) { +// const unquote = (x: string): string => +// x.replace(/^"+|"+$/g, ''); + +// this._name = unquote(text.split("= ")[1]); +// this._hasName = true; +// } +// } +// } + +// class ModuelHeaderElement extends BaseContextSyntaxElement { +// constructor(context: ModuleHeaderContext, document: TextDocument) { +// super(context, document); +// } +// } \ No newline at end of file diff --git a/server/src/project/elements/operator.ts b/server/src/project/elements/operator.ts index b8180b8..31e542c 100644 --- a/server/src/project/elements/operator.ts +++ b/server/src/project/elements/operator.ts @@ -1,20 +1,19 @@ import { BaseContextSyntaxElement, HasDiagnosticCapability } from './base'; -import { OperatorsStmtContext } from '../../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; import { Diagnostic } from 'vscode-languageserver'; import { MultipleOperatorsDiagnostic } from '../../capabilities/diagnostics'; -export class OperatorElement extends BaseContextSyntaxElement implements HasDiagnosticCapability { - diagnostics: Diagnostic[] = []; +// export class OperatorElement extends BaseContextSyntaxElement implements HasDiagnosticCapability { +// diagnostics: Diagnostic[] = []; - constructor(context: OperatorsStmtContext, document: TextDocument) { - super(context, document); - } +// constructor(context: OperatorsStmtContext, document: TextDocument) { +// super(context, document); +// } - evaluateDiagnostics(): void { - if (this.context.childCount > 1) { - this.diagnostics.push(new MultipleOperatorsDiagnostic(this.range)); - } - } -} +// evaluateDiagnostics(): void { +// if (this.context.childCount > 1) { +// this.diagnostics.push(new MultipleOperatorsDiagnostic(this.range)); +// } +// } +// } diff --git a/server/src/project/elements/special.ts b/server/src/project/elements/special.ts index 876cd8c..5b26fe5 100644 --- a/server/src/project/elements/special.ts +++ b/server/src/project/elements/special.ts @@ -1,4 +1,4 @@ -import { ParserRuleContext } from 'antlr4ts'; +import { ParserRuleContext } from 'antlr4ng'; import { FoldingRangeKind } from '../../capabilities/folding'; import { BaseContextSyntaxElement, FoldingRangeElement } from './base'; import { Range, TextDocument } from 'vscode-languageserver-textdocument'; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index ea99870..c38f99b 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,18 +1,16 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ModuleContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, ModuleContext, ProceduralModuleBodyContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; import { FoldableElement } from '../elements/special'; -import { ConstDeclarationsElement, EnumBlockDeclarationElement, EnumMemberDeclarationElement, MethodBlockDeclarationElement, TypeDeclarationElement, VariableDeclarationsElement } from '../elements/memory'; -import { ModuleElement } from '../elements/module'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; -import { OperatorElement } from '../elements/operator'; -import { WhileWendLoopElement } from '../elements/flow'; import { CharStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException, Recognizer } from 'antlr4ng'; +import { ClassElement, ModuleElement } from '../elements/module'; +import { DeclarationElement } from '../elements/memory'; export class SyntaxParser { private static _lockIdentifier = 0; @@ -95,6 +93,29 @@ class VbaListener extends vbaListener { this.document = document; } + enterProceduralModule = (ctx: ProceduralModuleContext) => { + const element = new ModuleElement(ctx, this.document.textDocument); + this.document.registerSymbolInformation(element) + .registerDiagnosticElement(element) + .registerScopedElement(element); + }; + + enterClassModule = (ctx: ClassModuleContext) => { + const element = new ClassElement(ctx, this.document.textDocument); + this.document.registerSymbolInformation(element) + .registerDiagnosticElement(element) + .registerScopedElement(element); + }; + + enterProcedureDeclaration = (ctx: ProcedureDeclarationContext) => { + // TODO: figure out how to handle scope for properties. + const element = DeclarationElement.create(ctx, this.document); + this.document.registerSymbolInformation(element) + .registerFoldableElement(element) + .registerNamedElement(element) + .registerScopedElement(element); + }; + // visitErrorNode(node: ErrorNode) { // console.log(node.payload); // } @@ -166,11 +187,11 @@ class VbaListener extends vbaListener { // enterOperatorsStmt = (ctx: OperatorsStmtContext) => { // const element = new OperatorElement(ctx, this.document.textDocument); // this.document.registerDiagnosticElement(element); - enterModule = (ctx: ModuleContext) => { - const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); - this.document.registerAttributeElement(element) - .registerScopedElement(element); - }; + // enterModule = (ctx: ModuleContext) => { + // const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); + // this.document.registerAttributeElement(element) + // .registerScopedElement(element); + // }; // enterTypeStmt = (ctx: TypeStmtContext) => { // const element = new TypeDeclarationElement(ctx, this.document.textDocument); diff --git a/server/src/server.ts b/server/src/server.ts index 623678a..8c4ca13 100644 --- a/server/src/server.ts +++ b/server/src/server.ts @@ -16,7 +16,6 @@ import { Workspace } from './project/workspace'; import { activateSemanticTokenProvider } from './capabilities/semanticTokens'; import { activateWorkspaceFolderCapability } from './capabilities/workspaceFolder'; - class LanguageServer { workspace?: Workspace; configuration?: LanguageServerConfiguration; From 6ae38bf762144cc63fca8d5ebbca237602e47a77 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 14:43:00 +0800 Subject: [PATCH 31/61] Add MissingAttributeDiagnostic and DuplicateAttributeDiagnostic --- server/src/capabilities/diagnostics.ts | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 8b9cc94..3ad6f0c 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -37,6 +37,26 @@ export class WhileWendDeprecatedDiagnostic extends BaseDiagnostic { } } +export class MissingAttributeDiagnostic extends BaseDiagnostic { + message: string; + severity = DiagnosticSeverity.Error; + + constructor(range: Range, attributeName: string) { + super(range); + this.message = `Module missing attribute ${attributeName}.`; + } +} + +export class DuplicateAttributeDiagnostic extends BaseDiagnostic { + message: string; + severity = DiagnosticSeverity.Error; + + constructor(range: Range, attributeName: string) { + super(range); + this.message = `Module duplicate attribute ${attributeName}.`; + } +} + export class MissingOptionExplicitDiagnostic extends BaseDiagnostic { message = "Option Explicit is missing from module header."; severity = DiagnosticSeverity.Warning; From 13dbf00ada33258a546ebff86a424ac576f7e5b6 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sat, 1 Jun 2024 15:17:37 +0800 Subject: [PATCH 32/61] Module supports Option Explicit diagnostic --- server/src/project/elements/module.ts | 28 ++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index cd3b2ce..0fc13a0 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -32,15 +32,26 @@ abstract class BaseModuleElement extends BaseContextSyntaxElement implements Has } export class ModuleElement extends BaseModuleElement implements ScopeElement { + context: ProceduralModuleContext; protected _name: string; constructor(context: ProceduralModuleContext, document: TextDocument) { super(context, document, SymbolKind.File); + this.context = context; this._name = this._getName(context); } evaluateDiagnostics(): void { - return; + if (!this._hasOptionExplicit()) { + const header = this.context.proceduralModuleHeader(); + const startLine = header.stop?.line ?? 0 + 1; + this.diagnostics.push(new MissingOptionExplicitDiagnostic( + Range.create( + startLine, 1, + startLine, 1 + ) + )); + } } private _getName(context: ProceduralModuleContext) { @@ -56,6 +67,21 @@ export class ModuleElement extends BaseModuleElement implements ScopeElement { return name?.stripQuotes() ?? 'Unknown Module'; } + + private _hasOptionExplicit(): boolean { + const moduleDeclarations = this.context.proceduralModuleBody().proceduralModuleDeclarationSection()?.proceduralModuleDeclarationElement(); + if (!moduleDeclarations) { + return false; + } + + for (const declaration of moduleDeclarations) { + if (declaration.commonOptionDirective()?.optionExplicitDirective()) { + return true; + } + } + + return false; + } } export class ClassElement extends BaseModuleElement { From 4a9fc91534fb0f90362ebfba4d10c0d5f07d89c0 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 11:08:22 +0800 Subject: [PATCH 33/61] Class supports MissingOptionExplicitDiagnostic --- server/src/project/elements/module.ts | 28 ++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index 0fc13a0..5c83d90 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -85,15 +85,26 @@ export class ModuleElement extends BaseModuleElement implements ScopeElement { } export class ClassElement extends BaseModuleElement { + context: ClassModuleContext; protected _name: string; constructor(context: ClassModuleContext, document: TextDocument) { super(context, document, SymbolKind.Class); + this.context = context; this._name = this._getName(context); } evaluateDiagnostics(): void { - return; + if (!this._hasOptionExplicit()) { + const header = this.context.classModuleHeader(); + const startLine = header.stop?.line ?? 0 + 1; + this.diagnostics.push(new MissingOptionExplicitDiagnostic( + Range.create( + startLine, 1, + startLine, 1 + ) + )); + } } private _getName(context: ClassModuleContext) { @@ -110,6 +121,21 @@ export class ClassElement extends BaseModuleElement { const nameAttribute = nameAttributes[0]; return nameAttribute.STRINGLITERAL().getText().stripQuotes(); } + + private _hasOptionExplicit(): boolean { + const moduleDeclarations = this.context.classModuleBody().classModuleDeclarationSection()?.classModuleDeclarationElement(); + if (!moduleDeclarations) { + return false; + } + + for (const declaration of moduleDeclarations) { + if (declaration.commonOptionDirective()?.optionExplicitDirective()) { + return true; + } + } + + return false; + } } From 3796d6e4a17447f487275974e35c5403894b83cc Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 15:10:16 +0800 Subject: [PATCH 34/61] Fixed issue causing Optional not to be recognised in arguments list --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index db6b1f4..a6ae1b5 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -376,7 +376,7 @@ repository: - include: "#argsLiteral" repository: argsVariable: - match: (?i),?\s*((?:Optional\s+)?(?:ByVal|ByRef)\s+)?([a-z][a-z0-9_]*)(?:\s+(as\s+[a-z][a-z0-9_]*))?(\s*=\s*[^,)]+)? + match: (?i),?\s*((?:Optional\s+)?(?:(?:ByVal|ByRef)\s+)?)?([a-z][a-z0-9_]*)(?:\s+(as\s+[a-z][a-z0-9_]*))?(\s*=\s*[^,)]+)? captures: 1: # Optional? ByVal|ByRef? name: storage.type.modifier.vba From db940189d640bcdcd04c1bcc749817cd29497c38 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:03:43 +0800 Subject: [PATCH 35/61] String literals now behave like they do in VBA --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index a6ae1b5..0a81f05 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -83,7 +83,7 @@ repository: repository: string: name: string.quoted.double.vba - match: '"[^\r\n]*"' + match: '"("")*([^"\n]*)((?:"")[^"\n]+)?"("")*' boolean: name: constant.language.boolean.vba match: "(?i)(true|false)" From 0029656ffebfdcc4172af6779022eaca7e12da3b Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:04:28 +0800 Subject: [PATCH 36/61] end if # now optional --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 0a81f05..44ccf29 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -152,7 +152,7 @@ repository: repository: flowDecision: name: keyword.control.flow.decision.vba - match: (?i)(^|\s+)(#if|then|#elseif|[#]?else|#end if|select case|case|switch|end select)\b + match: (?i)(^|\s+)(#if|then|#elseif|[#]?else|[#]?end if|select case|case|switch|end select)\b flowLoop: name: keyword.control.flow.loop.vba From bebbb2111470df9f0c2f5c862df8c2b69285dd94 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:09:35 +0800 Subject: [PATCH 37/61] Method signature no longer requires space before closing paren --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 44ccf29..d176461 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -590,7 +590,7 @@ repository: methodSignature: name: source.method.signature.vba begin: (?i)^\s*((?:Public|Private)?\b\s*(?:(?:Sub|Function)|Property\s+(?:Let|Get|Set)))\s+([a-z][a-z0-9_]*)\s*(\() - end: (?i)(\))\s+(as\s+[a-z][a-z0-9_]*)? + end: (?i)\s*(\))\s+(as\s+[a-z][a-z0-9_]*)? beginCaptures: 1: name: storage.type.method.vba From 44125c90ae9b8dbb1da0ad95bc3141cd672ab7d1 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:10:04 +0800 Subject: [PATCH 38/61] Expressions can now have function calls on left side --- client/src/syntaxes/vba.tmLanguage.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index d176461..18ea048 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -623,6 +623,7 @@ repository: captures: 1: # Left sided of expression patterns: + - include: "#functionCall" - include: "#literal" 2: # Operator patterns: From 35aad822974ccc2e4d345eeae5cd70d5ba60ae19 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:10:50 +0800 Subject: [PATCH 39/61] Sub calls no longer required to have multiple args to work --- client/src/syntaxes/vba.tmLanguage.yaml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 18ea048..bd436c4 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -731,7 +731,8 @@ repository: - include: "#lineContinuation" subCall: - begin: (?i)([a-z][a-z0-9._]*)\s+(.*,.*) + name: meta.sub-call.vba + begin: (?i)([a-z][a-z0-9._]*)\s+(.*) beginCaptures: 1: name: entity.name.function.call.vba From bc8e9ac4d016f2e085ed7deefa99ee87128f4b49 Mon Sep 17 00:00:00 2001 From: sslinky Date: Sun, 2 Jun 2024 23:11:57 +0800 Subject: [PATCH 40/61] subCall lower in priority to avoid overriding object model --- client/src/syntaxes/vba.tmLanguage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index bd436c4..c7d0a0d 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -69,8 +69,8 @@ repository: - include: "#operators" - include: "#keywords" - include: "#functionCall" - - include: "#subCall" - include: "#objectModel" + - include: "#subCall" literals: From a28e9e73b9f6284da47c896b404df1c9884a0dfd Mon Sep 17 00:00:00 2001 From: sslinky Date: Mon, 3 Jun 2024 01:00:52 +0800 Subject: [PATCH 41/61] Fixes escape issue in expressions --- client/src/syntaxes/vba.tmLanguage.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index c7d0a0d..a829db5 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -612,14 +612,14 @@ repository: match: (?i)^\s*End\s+(Sub|Function|Property) expression: - # (?:[*&/\+-]|\bMod\b)| + # (?:[*&\/\+-]|\bMod\b)| # (?:[<>=]|\b(is|like)\b)| # (?:[&+])| # (?:\b(and|eqv|imp|not|or|xor)\b)| # (?:\b(addressof|typeof)\b) # This match just made up of the operators matchs. Don't look at it too hard. - match: (?i)(.*?)\s+((?:[*&/\+-]|\bMod\b)|(?:[<>=]|\b(is|like)\b)|(?:[&+])|(?:\b(and|eqv|imp|not|or|xor)\b)|(?:\b(addressof|typeof)\b))\s+(.*) + match: (?i)(.*?)\s+((?:[*&\/\+-]|\bMod\b)|(?:[<>=]|\b(is|like)\b)|(?:[&+])|(?:\b(and|eqv|imp|not|or|xor)\b)|(?:\b(addressof|typeof)\b))\s+(.*) captures: 1: # Left sided of expression patterns: From c29e05bbe18bf4778e309dce26d84bf7d1c8b205 Mon Sep 17 00:00:00 2001 From: sslinky Date: Mon, 3 Jun 2024 01:03:59 +0800 Subject: [PATCH 42/61] Fixed attributes --- client/src/syntaxes/vba.tmLanguage.yaml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index a829db5..6af4996 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -430,10 +430,12 @@ repository: match: (?i)(?<=^|:)\s*Rem\b.* attribute: - name: entity.other.attribute-name.vba - match: (?i)^Attribute(.*) + name: meta.attribute.vba + match: (?i)^\s*(Attribute VB_\w+)\s+(.*)$ captures: - 0: + 1: + name: entity.other.attribute-name.vba + 2: patterns: - include: "#language" From 46434dd7eb016069bbc10c70f8a805fd796faacf Mon Sep 17 00:00:00 2001 From: sslinky Date: Mon, 3 Jun 2024 01:05:01 +0800 Subject: [PATCH 43/61] Attempting to handle args with line separators --- client/src/syntaxes/vba.tmLanguage.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index 6af4996..f72222b 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -376,7 +376,11 @@ repository: - include: "#argsLiteral" repository: argsVariable: + name: meta.arguments.argsVariable.vba match: (?i),?\s*((?:Optional\s+)?(?:(?:ByVal|ByRef)\s+)?)?([a-z][a-z0-9_]*)(?:\s+(as\s+[a-z][a-z0-9_]*))?(\s*=\s*[^,)]+)? + # Attempted replacing \s with (?:\s+|\s*_\s*\n) to consume a space or a line ending but it refuses to play the game. + # match: ~~ doesn't work (?i),?(?:\s+|\s*_\s*\n)*((?:Optional(?:\s+|\s*_\s*\n)+)?(?:(?:ByVal|ByRef)(?:\s+|\s*_\s*\n)+)?)?([a-z][a-z0-9_]*)(?:(?:\s+|\s*_\s*\n)+(as(?:\s+|\s*_\s*\n)+[a-z][a-z0-9_]*))?((?:\s+|\s*_\s*\n)*=(?:\s+|\s*_\s*\n)*[^,\n)]+)? + # match: ~~ all broken (?i),?(?:\s*_\s*\n)*((?:Optional(?:\s+(?:\s*_\s*\n)*))?(?:(?:ByVal|ByRef)(?:\s+(?:\s*_\s*\n)*))?)?([a-z][a-z0-9_]*)(?:(?:\s+(?:\s*_\s*\n)*)(as\(?:\s+(?:\s*_\s*\n)*)[a-z][a-z0-9_]*))?((?:\s*_\s*\n)*=(?:\s*_\s*\n)*[^,)]+)? captures: 1: # Optional? ByVal|ByRef? name: storage.type.modifier.vba @@ -398,6 +402,7 @@ repository: - include: "#literals" paramArray: + name: meta.args.paramarray.vba match: (?i),?\s*(ParamArray)\s+([a-z][a-z0-9_]*)(?:\(\))(\s+As\s+Variant)? captures: 1: From 943d045972c5fdd2799e5ed823be921b0b339784 Mon Sep 17 00:00:00 2001 From: sslinky Date: Mon, 3 Jun 2024 01:05:53 +0800 Subject: [PATCH 44/61] line separated args still not working --- client/src/syntaxes/vba.tmLanguage.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/client/src/syntaxes/vba.tmLanguage.yaml b/client/src/syntaxes/vba.tmLanguage.yaml index f72222b..092734f 100644 --- a/client/src/syntaxes/vba.tmLanguage.yaml +++ b/client/src/syntaxes/vba.tmLanguage.yaml @@ -353,10 +353,10 @@ repository: repository: primativeType: name: support.type.primitive.vba - match: (?i)(?<=\bAs)\s+(boolean|byte|currency|date|decimal|double|integer|long(long|ptr)?|single|string|variant)\b + match: (?i)(?<=\bAs)(?:\s+|\s+_\s*\n)+(boolean|byte|currency|date|decimal|double|integer|long(long|ptr)?|single|string|variant)\b objectType: name: support.type.object.vba - match: (?i)(?<=\bAs)(\s+New)?\s+([A-Z][A-Z0-9_]*)\b + match: (?i)(?<=\bAs)((?:\s+(?:\s*_\s*\n)*)New)?(?:\s+(?:\s*_\s*\n)*)([A-Z][A-Z0-9_]*)\b captures: 1: name: keyword.storage.new.vba From 803306d8525fc6644e19f027d3ba54654ffb02ab Mon Sep 17 00:00:00 2001 From: sslinky Date: Mon, 3 Jun 2024 01:06:16 +0800 Subject: [PATCH 45/61] 1.3.6 --- package-lock.json | 4 ++-- package.json | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package-lock.json b/package-lock.json index b3326fe..7252ff5 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "vba-lsp", - "version": "1.3.5", + "version": "1.3.6", "lockfileVersion": 2, "requires": true, "packages": { "": { "name": "vba-lsp", - "version": "1.3.5", + "version": "1.3.6", "hasInstallScript": true, "license": "MIT", "devDependencies": { diff --git a/package.json b/package.json index cfe420f..4c28ad7 100644 --- a/package.json +++ b/package.json @@ -5,7 +5,7 @@ "icon": "images/vba-lsp-icon.png", "author": "SSlinky", "license": "MIT", - "version": "1.3.5", + "version": "1.3.6", "repository": { "type": "git", "url": "https://github.com/SSlinky/VBA-LanguageServer" From e5c69225f4bc47f8be7c9c60c6d669ba7be9964b Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 06:08:16 +0800 Subject: [PATCH 46/61] INTEGERLITERAL now supports negative numbers --- server/src/antlr/vba.g4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 6e85ed6..cb45dc0 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -2563,7 +2563,7 @@ STRINGLITERAL ; INTEGERLITERAL - : (DIGIT DIGIT* + : [-]? (DIGIT DIGIT* | '&H' [0-9A-F]+ | '&' [O]? [0-7]+) [%&^]? ; From 093682e44cd976c0a0f40e3c08b0eefe04f4b769 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 11:56:35 +0800 Subject: [PATCH 47/61] JS !== Python --- server/src/project/document.ts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index ee1f84d..1f01fcb 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -34,7 +34,7 @@ export abstract class BaseProjectDocument { } get currentScopeElement() { - return this._elementParents[-1]; + return this._elementParents.at(-1); } // get activeAttributeElement() { From 5cabb06bf873de7dfe47615f493e858d0a0bddd6 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 11:56:59 +0800 Subject: [PATCH 48/61] Support for ignored attributes --- server/src/antlr/vba.g4 | 8 ++++++-- server/src/capabilities/diagnostics.ts | 8 ++++++++ server/src/project/elements/memory.ts | 2 +- server/src/project/elements/module.ts | 19 +++++++++++++++++-- server/src/project/parser/vbaSyntaxParser.ts | 17 +++++++++++------ 5 files changed, 43 insertions(+), 11 deletions(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index cb45dc0..60c6abf 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -78,7 +78,7 @@ classModule proceduralModuleHeader : endOfLine* nameAttr? ; -classModuleHeader: (endOfLine+ (classAttr | nameAttr))* WS?; +classModuleHeader: (endOfLine+ (classAttr | nameAttr | ignoredAttr))* WS?; // VBA Library Projects are allowed to have GoobalNamespace and creatable as true. classAttr @@ -90,6 +90,10 @@ classAttr | ATTRIBUTE WS? VB_CUSTOMIZABLE WS? EQ WS? booleanLiteralIdentifier ; +ignoredAttr + : ATTRIBUTE WS? ambiguousIdentifier WS? EQ WS? expression + ; + nameAttr : ATTRIBUTE WS? VB_NAME WS? EQ WS? STRINGLITERAL ; @@ -2563,7 +2567,7 @@ STRINGLITERAL ; INTEGERLITERAL - : [-]? (DIGIT DIGIT* + : MINUS? (DIGIT DIGIT* | '&H' [0-9A-F]+ | '&' [O]? [0-7]+) [%&^]? ; diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 3ad6f0c..4d87979 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -57,6 +57,14 @@ export class DuplicateAttributeDiagnostic extends BaseDiagnostic { } } +export class IgnoredAttributeDiagnostic extends BaseDiagnostic { + message = "This attribute will be ignored."; + severity = DiagnosticSeverity.Information; + constructor(range: Range) { + super(range); + } +} + export class MissingOptionExplicitDiagnostic extends BaseDiagnostic { message = "Option Explicit is missing from module header."; severity = DiagnosticSeverity.Warning; diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 7f2f2c4..4b6d9c5 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -40,7 +40,7 @@ export abstract class DeclarationElement extends FoldableElement implements Scop } const propertyDeclaration = new PropertyDeclarationElement(context, document.textDocument); - const predeclaredElement = document.currentScopeElement.declaredNames.get(propertyDeclaration.identifier.text); + const predeclaredElement = document.currentScopeElement?.declaredNames.get(propertyDeclaration.identifier.text); if (predeclaredElement && isPropertyDeclarationElement(predeclaredElement)) { predeclaredElement.addPropertyDeclaration(context, document.textDocument); return predeclaredElement; diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index 5c83d90..103afa3 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -1,9 +1,9 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { Diagnostic, Range, SymbolInformation, SymbolKind } from 'vscode-languageserver'; -import { ClassModuleContext, ProceduralModuleContext } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, IgnoredAttrContext, ProceduralModuleContext } from '../../antlr/out/vbaParser'; import { BaseContextSyntaxElement, BaseSyntaxElement, HasDiagnosticCapability, HasSymbolInformation, ScopeElement } from './base'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; -import { MissingAttributeDiagnostic, MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; +import { IgnoredAttributeDiagnostic, MissingAttributeDiagnostic, MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; import '../../extensions/stringExtensions'; @@ -138,6 +138,21 @@ export class ClassElement extends BaseModuleElement { } } +export class IgnoredAttributeElement extends BaseContextSyntaxElement implements HasDiagnosticCapability { + diagnostics: Diagnostic[] = []; + + constructor(context: IgnoredAttrContext, document: TextDocument) { + super(context, document); + } + + evaluateDiagnostics(): void { + this.diagnostics.push( + new IgnoredAttributeDiagnostic(this.range) + ) + } + +} + // export class ModuleElement2 extends BaseContextSyntaxElement implements HasSymbolInformation, HasAttribute, HasDiagnosticCapability { // private _hasName = false; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index c38f99b..680675e 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,7 +1,7 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ClassModuleContext, ModuleContext, ProceduralModuleBodyContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, IgnoredAttrContext, ModuleContext, ProceduralModuleBodyContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -9,7 +9,7 @@ import { FoldableElement } from '../elements/special'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; import { CharStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException, Recognizer } from 'antlr4ng'; -import { ClassElement, ModuleElement } from '../elements/module'; +import { ClassElement, IgnoredAttributeElement, ModuleElement } from '../elements/module'; import { DeclarationElement } from '../elements/memory'; export class SyntaxParser { @@ -93,15 +93,20 @@ class VbaListener extends vbaListener { this.document = document; } - enterProceduralModule = (ctx: ProceduralModuleContext) => { - const element = new ModuleElement(ctx, this.document.textDocument); + enterClassModule = (ctx: ClassModuleContext) => { + const element = new ClassElement(ctx, this.document.textDocument); this.document.registerSymbolInformation(element) .registerDiagnosticElement(element) .registerScopedElement(element); }; - enterClassModule = (ctx: ClassModuleContext) => { - const element = new ClassElement(ctx, this.document.textDocument); + enterIgnoredAttr = (ctx: IgnoredAttrContext) => { + const element = new IgnoredAttributeElement(ctx, this.document.textDocument); + this.document.registerDiagnosticElement(element); + }; + + enterProceduralModule = (ctx: ProceduralModuleContext) => { + const element = new ModuleElement(ctx, this.document.textDocument); this.document.registerSymbolInformation(element) .registerDiagnosticElement(element) .registerScopedElement(element); From f70eda23315b7220b71a5d7d76ab744f2400e8d2 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 14:52:51 +0800 Subject: [PATCH 49/61] Implement enums. Create base Scope element. --- server/src/project/document.ts | 3 +- server/src/project/elements/base.ts | 3 +- server/src/project/elements/memory.ts | 83 ++++++++++++++++---- server/src/project/elements/module.ts | 8 +- server/src/project/elements/special.ts | 17 +++- server/src/project/parser/vbaSyntaxParser.ts | 20 ++++- 6 files changed, 105 insertions(+), 29 deletions(-) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index 1f01fcb..93b412e 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -1,4 +1,4 @@ -import { CancellationToken, Diagnostic, LSPErrorCodes, PublishDiagnosticsParams, ResponseError, SemanticTokens, SymbolInformation, SymbolKind } from 'vscode-languageserver'; +import { CancellationToken, Diagnostic, PublishDiagnosticsParams, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { Workspace } from './workspace'; import { FoldableElement } from './elements/special'; import { BaseSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, ScopeElement } from './elements/base'; @@ -6,7 +6,6 @@ import { Range, TextDocument } from 'vscode-languageserver-textdocument'; import { SyntaxParser } from './parser/vbaSyntaxParser'; import { FoldingRange } from '../capabilities/folding'; import { SemanticTokensManager } from '../capabilities/semanticTokens'; -import { sleep } from '../utils/helpers'; export abstract class BaseProjectDocument { diff --git a/server/src/project/elements/base.ts b/server/src/project/elements/base.ts index cdec41b..75284f7 100644 --- a/server/src/project/elements/base.ts +++ b/server/src/project/elements/base.ts @@ -54,7 +54,7 @@ export interface FoldingRangeElement { } export interface ScopeElement { - declaredNames: Map; + declaredNames: Map; } export abstract class BaseSyntaxElement implements ContextOptionalSyntaxElement { @@ -107,3 +107,4 @@ export abstract class BaseContextSyntaxElement extends BaseSyntaxElement { super(ctx, doc); } } + diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 4b6d9c5..580429d 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,10 +1,10 @@ -import { AmbiguousIdentifierContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, SubroutineDeclarationContext } from '../../antlr/out/vbaParser'; +import { AmbiguousIdentifierContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, SubroutineDeclarationContext } from '../../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; -import { BaseContextSyntaxElement, BaseSyntaxElement, HasSemanticToken, HasSymbolInformation, ScopeElement } from './base'; +import { BaseContextSyntaxElement, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement } from './base'; import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; -import { FoldableElement } from './special'; +import { ScopeElement } from './special'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import '../../extensions/parserExtensions'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -16,9 +16,8 @@ export class IdentifierElement extends BaseContextSyntaxElement { } } -export abstract class DeclarationElement extends FoldableElement implements ScopeElement { +export abstract class DeclarationElement extends ScopeElement { abstract identifier: IdentifierElement; - abstract declaredNames: Map; constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); @@ -40,11 +39,13 @@ export abstract class DeclarationElement extends FoldableElement implements Scop } const propertyDeclaration = new PropertyDeclarationElement(context, document.textDocument); - const predeclaredElement = document.currentScopeElement?.declaredNames.get(propertyDeclaration.identifier.text); - if (predeclaredElement && isPropertyDeclarationElement(predeclaredElement)) { - predeclaredElement.addPropertyDeclaration(context, document.textDocument); - return predeclaredElement; - } + const predeclaredElements = document.currentScopeElement?.declaredNames.get(propertyDeclaration.identifier.text); + predeclaredElements?.forEach(predeclaredElement => { + if (predeclaredElement && isPropertyDeclarationElement(predeclaredElement)) { + predeclaredElement.addPropertyDeclaration(context, document.textDocument); + return predeclaredElement; + } + }); return propertyDeclaration; } @@ -53,7 +54,6 @@ export abstract class DeclarationElement extends FoldableElement implements Scop export class SubDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; symbolInformation: SymbolInformation; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: SubroutineDeclarationContext) { super(context, document); @@ -72,7 +72,6 @@ export class SubDeclarationElement extends DeclarationElement implements HasSymb export class FunctionDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; symbolInformation: SymbolInformation; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: FunctionDeclarationContext) { super(context, document); @@ -93,7 +92,6 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha getDeclarations: PropertyGetDeclarationElement[] = []; letDeclarations: PropertyLetDeclarationElement[] = []; setDeclarations: PropertyLetDeclarationElement[] = []; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); @@ -126,7 +124,6 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha class PropertyGetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument, getContext: PropertyGetDeclarationContext) { super(context, document); @@ -136,7 +133,6 @@ class PropertyGetDeclarationElement extends DeclarationElement { class PropertyLetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); @@ -146,7 +142,6 @@ class PropertyLetDeclarationElement extends DeclarationElement { class PropertySetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; - declaredNames: Map = new Map(); constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); @@ -154,10 +149,64 @@ class PropertySetDeclarationElement extends DeclarationElement { } } -function isPropertyDeclarationElement(element: BaseSyntaxElement): element is PropertyDeclarationElement { +function isPropertyDeclarationElement(element: IdentifiableSyntaxElement): element is PropertyDeclarationElement { return 'getDeclarations' in element; } +abstract class BaseEnumDeclarationElement extends ScopeElement implements HasSemanticToken, HasSymbolInformation { + identifier: IdentifierElement; + tokenModifiers: SemanticTokenModifiers[] = []; + declaredNames: Map = new Map(); + + abstract tokenType: SemanticTokenTypes; + abstract symbolInformation: SymbolInformation; + + get name(): string { + return this.identifier.text; + } + + constructor(context: EnumDeclarationContext | EnumMemberContext, document: TextDocument) { + super(context, document); + this.identifier = new IdentifierElement(context.untypedName().ambiguousIdentifier()!, document); + } + +} + +export class EnumDeclarationElement extends BaseEnumDeclarationElement implements ScopeElement { + tokenType: SemanticTokenTypes; + + constructor(context: EnumDeclarationContext, document: TextDocument) { + super(context, document); + this.tokenType = SemanticTokenTypes.enum; + this.identifier = new IdentifierElement(context.untypedName().ambiguousIdentifier()!, document); + context.enumMemberList().enumElement().forEach(enumElementContext => + this._pushDeclaredName(new EnumMemberDeclarationElement(enumElementContext.enumMember()!, document)) + ); + } + + get symbolInformation(): SymbolInformation { + return SymbolInformationFactory.create( + this, SymbolKind.Enum + ); + } +} + +class EnumMemberDeclarationElement extends BaseEnumDeclarationElement { + tokenType: SemanticTokenTypes; + + constructor(context: EnumMemberContext, document: TextDocument) { + super(context, document); + this.tokenType = SemanticTokenTypes.enumMember; + this.identifier = new IdentifierElement(context.untypedName().ambiguousIdentifier()!, document); + } + + get symbolInformation(): SymbolInformation { + return SymbolInformationFactory.create( + this, SymbolKind.EnumMember + ); + } +} + // abstract class BaseEnumElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { // identifier: IdentifierElement; diff --git a/server/src/project/elements/module.ts b/server/src/project/elements/module.ts index 103afa3..727bea3 100644 --- a/server/src/project/elements/module.ts +++ b/server/src/project/elements/module.ts @@ -1,17 +1,17 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { Diagnostic, Range, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { ClassModuleContext, IgnoredAttrContext, ProceduralModuleContext } from '../../antlr/out/vbaParser'; -import { BaseContextSyntaxElement, BaseSyntaxElement, HasDiagnosticCapability, HasSymbolInformation, ScopeElement } from './base'; +import { BaseContextSyntaxElement, HasDiagnosticCapability, HasSymbolInformation } from './base'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import { IgnoredAttributeDiagnostic, MissingAttributeDiagnostic, MissingOptionExplicitDiagnostic } from '../../capabilities/diagnostics'; import '../../extensions/stringExtensions'; +import { ScopeElement } from './special'; -abstract class BaseModuleElement extends BaseContextSyntaxElement implements HasSymbolInformation, HasDiagnosticCapability { +abstract class BaseModuleElement extends ScopeElement implements HasSymbolInformation, HasDiagnosticCapability { protected abstract _name: string; symbolKind: SymbolKind; diagnostics: Diagnostic[] = []; - declaredNames: Map = new Map(); constructor(context: ProceduralModuleContext | ClassModuleContext, document: TextDocument, symbolKind: SymbolKind) { super(context, document); @@ -31,7 +31,7 @@ abstract class BaseModuleElement extends BaseContextSyntaxElement implements Has abstract evaluateDiagnostics(): void; } -export class ModuleElement extends BaseModuleElement implements ScopeElement { +export class ModuleElement extends BaseModuleElement { context: ProceduralModuleContext; protected _name: string; diff --git a/server/src/project/elements/special.ts b/server/src/project/elements/special.ts index 5b26fe5..7cd6c36 100644 --- a/server/src/project/elements/special.ts +++ b/server/src/project/elements/special.ts @@ -1,6 +1,6 @@ import { ParserRuleContext } from 'antlr4ng'; import { FoldingRangeKind } from '../../capabilities/folding'; -import { BaseContextSyntaxElement, FoldingRangeElement } from './base'; +import { BaseContextSyntaxElement, FoldingRangeElement, IdentifiableSyntaxElement } from './base'; import { Range, TextDocument } from 'vscode-languageserver-textdocument'; @@ -13,3 +13,18 @@ export class FoldableElement extends BaseContextSyntaxElement implements Folding this.foldingRangeKind = foldingRangeKind; } } + +export class ScopeElement extends FoldableElement implements ScopeElement { + declaredNames: Map = new Map(); + + constructor(ctx: ParserRuleContext, doc: TextDocument) { + super(ctx, doc); + } + + protected _pushDeclaredName(element: IdentifiableSyntaxElement) { + const name = element.identifier.text; + const names: IdentifiableSyntaxElement[] = this.declaredNames.get(name) ?? []; + names.push(element); + this.declaredNames.set(name, names); + } +} diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 680675e..b8f8243 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,16 +1,15 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ClassModuleContext, IgnoredAttrContext, ModuleContext, ProceduralModuleBodyContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; -import { FoldableElement } from '../elements/special'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; -import { CharStream, CommonTokenStream, ConsoleErrorListener, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException, Recognizer } from 'antlr4ng'; +import { CharStream, CommonTokenStream, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException } from 'antlr4ng'; import { ClassElement, IgnoredAttributeElement, ModuleElement } from '../elements/module'; -import { DeclarationElement } from '../elements/memory'; +import { DeclarationElement, EnumDeclarationElement } from '../elements/memory'; export class SyntaxParser { private static _lockIdentifier = 0; @@ -93,6 +92,19 @@ class VbaListener extends vbaListener { this.document = document; } + enterEnumDeclaration = (ctx: EnumDeclarationContext) => { + const element = new EnumDeclarationElement(ctx, this.document.textDocument); + this.document.registerFoldableElement(element) + .registerScopedElement(element) + .registerSemanticToken(element) + .registerSymbolInformation(element); + element.declaredNames.forEach(names => + names.forEach(name => this.document + .registerSemanticToken(name) + .registerSymbolInformation(name)) + ); + }; + enterClassModule = (ctx: ClassModuleContext) => { const element = new ClassElement(ctx, this.document.textDocument); this.document.registerSymbolInformation(element) From ef8750843fdcfaaef0dd9d9f82a0002e1697141b Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 15:17:11 +0800 Subject: [PATCH 50/61] Implemented WhileWend diagnostic --- server/src/capabilities/diagnostics.ts | 7 +++- server/src/project/elements/flow.ts | 39 +++++++------------- server/src/project/parser/vbaSyntaxParser.ts | 8 +++- 3 files changed, 25 insertions(+), 29 deletions(-) diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 4d87979..4befea3 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -1,4 +1,4 @@ -import { CodeDescription, Diagnostic, DiagnosticRelatedInformation, DiagnosticSeverity, DiagnosticTag, Range, TextDocumentClientCapabilities } from 'vscode-languageserver'; +import { CodeDescription, Diagnostic, DiagnosticRelatedInformation, DiagnosticSeverity, DiagnosticTag, Position, Range, TextDocumentClientCapabilities } from 'vscode-languageserver'; function hasDiagnosticRelatedInformationCapability(x: TextDocumentClientCapabilities) { @@ -33,7 +33,10 @@ export class WhileWendDeprecatedDiagnostic extends BaseDiagnostic { message = "The Do...Loop statement provides a more structured and flexible way to perform looping."; severity = DiagnosticSeverity.Information; constructor(range: Range) { - super(range); + super(Range.create( + range.start, + Position.create(range.start.line, range.start.character + 4) + )); } } diff --git a/server/src/project/elements/flow.ts b/server/src/project/elements/flow.ts index 48b9451..0afd9a5 100644 --- a/server/src/project/elements/flow.ts +++ b/server/src/project/elements/flow.ts @@ -1,33 +1,20 @@ -import { ParserRuleContext } from 'antlr4ng'; -import { BaseContextSyntaxElement, HasDiagnosticCapability } from './base'; -import { TextDocument } from 'vscode-languageserver-textdocument'; import { Diagnostic } from 'vscode-languageserver'; +import { TextDocument } from 'vscode-languageserver-textdocument'; +import { WhileStatementContext } from '../../antlr/out/vbaParser'; + +import { BaseContextSyntaxElement, HasDiagnosticCapability } from './base'; import { WhileWendDeprecatedDiagnostic } from '../../capabilities/diagnostics'; -class BaseLoopElement extends BaseContextSyntaxElement { - constructor(context: ParserRuleContext, document: TextDocument) { +export class WhileLoopElement extends BaseContextSyntaxElement implements HasDiagnosticCapability { + diagnostics: Diagnostic[] = []; + + constructor(context: WhileStatementContext, document: TextDocument) { super(context, document); + } -} - -// export class WhileWendLoopElement extends BaseLoopElement implements HasDiagnosticCapability { -// diagnostics: Diagnostic[] = []; -// valueStatement: ValueStatementElement; - -// constructor(context: WhileWendStmtContext, document: TextDocument) { -// super(context, document); -// this.valueStatement = new ValueStatementElement(context.valueStmt(), document); -// } - -// evaluateDiagnostics(): void { -// this.diagnostics.push(new WhileWendDeprecatedDiagnostic(this.valueStatement.range)); -// } -// } - -// class ValueStatementElement extends BaseContextSyntaxElement { -// constructor(context: ValueStmtContext, document: TextDocument) { -// super(context, document); -// } -// } \ No newline at end of file + evaluateDiagnostics(): void { + this.diagnostics.push(new WhileWendDeprecatedDiagnostic(this.range)) + } +} diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index b8f8243..f3818d6 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,7 +1,7 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, WhileStatementContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -10,6 +10,7 @@ import { CancellationToken } from 'vscode-languageserver'; import { CharStream, CommonTokenStream, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException } from 'antlr4ng'; import { ClassElement, IgnoredAttributeElement, ModuleElement } from '../elements/module'; import { DeclarationElement, EnumDeclarationElement } from '../elements/memory'; +import { WhileLoopElement } from '../elements/flow'; export class SyntaxParser { private static _lockIdentifier = 0; @@ -133,6 +134,11 @@ class VbaListener extends vbaListener { .registerScopedElement(element); }; + enterWhileStatement = (ctx: WhileStatementContext) => { + const element = new WhileLoopElement(ctx, this.document.textDocument); + this.document.registerDiagnosticElement(element); + }; + // visitErrorNode(node: ErrorNode) { // console.log(node.payload); // } From f47c498c2923018099844e52487a718d60fd0fec Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 15:21:25 +0800 Subject: [PATCH 51/61] Enter scopes now paird with exits --- server/src/project/parser/vbaSyntaxParser.ts | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index f3818d6..160ec60 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -106,6 +106,10 @@ class VbaListener extends vbaListener { ); }; + exitEnumDeclaration = (_: EnumDeclarationContext) => { + this.document.deregisterScopedElement(); + }; + enterClassModule = (ctx: ClassModuleContext) => { const element = new ClassElement(ctx, this.document.textDocument); this.document.registerSymbolInformation(element) @@ -113,6 +117,10 @@ class VbaListener extends vbaListener { .registerScopedElement(element); }; + exitClassModule = (ctx: ClassModuleContext) => { + this.document.deregisterScopedElement(); + }; + enterIgnoredAttr = (ctx: IgnoredAttrContext) => { const element = new IgnoredAttributeElement(ctx, this.document.textDocument); this.document.registerDiagnosticElement(element); @@ -125,6 +133,10 @@ class VbaListener extends vbaListener { .registerScopedElement(element); }; + exitProceduralModule = (ctx: ProceduralModuleContext) => { + this.document.deregisterScopedElement(); + }; + enterProcedureDeclaration = (ctx: ProcedureDeclarationContext) => { // TODO: figure out how to handle scope for properties. const element = DeclarationElement.create(ctx, this.document); @@ -134,6 +146,10 @@ class VbaListener extends vbaListener { .registerScopedElement(element); }; + exitProcedureDeclaration = (ctx: ProcedureDeclarationContext) => { + this.document.deregisterScopedElement(); + }; + enterWhileStatement = (ctx: WhileStatementContext) => { const element = new WhileLoopElement(ctx, this.document.textDocument); this.document.registerDiagnosticElement(element); From 5ab618a56b8a851a0684809f07b11fbc2cd313c2 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 15:25:51 +0800 Subject: [PATCH 52/61] Enabled error node logging --- server/src/project/parser/vbaSyntaxParser.ts | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 160ec60..cfb8895 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -155,9 +155,9 @@ class VbaListener extends vbaListener { this.document.registerDiagnosticElement(element); }; - // visitErrorNode(node: ErrorNode) { - // console.log(node.payload); - // } + visitErrorNode(node: ErrorNode) { + console.log(node.getPayload()); + } // enterAttributeStmt = (ctx: AttributeStmtContext) => { // this.document.activeAttributeElement?.processAttribute(ctx); From 0bd616b88962a8dbaa94bfa0d622025c4ff9f7fe Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 15:47:16 +0800 Subject: [PATCH 53/61] No longer throws for forms. --- server/src/project/document.ts | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/server/src/project/document.ts b/server/src/project/document.ts index 93b412e..f695e8d 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -61,8 +61,10 @@ export abstract class BaseProjectDocument { return new VbaClassDocument(workspace, filename, document, SymbolKind.Class); case 'bas': return new VbaModuleDocument(workspace, filename, document, SymbolKind.Class); + case 'frm': + return new VbaModuleDocument(workspace, filename, document, SymbolKind.Class); default: - throw new Error("Expected *.cls or *.bas but got *." + extension); + throw new Error("Expected *.cls, *.bas, or *.frm but got *." + extension); } } From b35dc9377e1bd7609cb3bfa6972cba81dbdf9499 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 15:47:52 +0800 Subject: [PATCH 54/61] Enabled Type declarations --- server/src/project/elements/memory.ts | 124 ++++--------------- server/src/project/parser/vbaSyntaxParser.ts | 68 ++-------- 2 files changed, 34 insertions(+), 158 deletions(-) diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 580429d..a70fd40 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,8 +1,8 @@ -import { AmbiguousIdentifierContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, SubroutineDeclarationContext } from '../../antlr/out/vbaParser'; +import { AmbiguousIdentifierContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, PublicTypeDeclarationContext, SubroutineDeclarationContext, UdtDeclarationContext, UntypedNameContext } from '../../antlr/out/vbaParser'; import { TextDocument } from 'vscode-languageserver-textdocument'; -import { BaseContextSyntaxElement, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement } from './base'; +import { BaseContextSyntaxElement, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, NamedSyntaxElement } from './base'; import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { ScopeElement } from './special'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; @@ -11,7 +11,7 @@ import { VbaClassDocument, VbaModuleDocument } from '../document'; export class IdentifierElement extends BaseContextSyntaxElement { - constructor(ctx: AmbiguousIdentifierContext, doc: TextDocument) { + constructor(ctx: UntypedNameContext | AmbiguousIdentifierContext, doc: TextDocument) { super(ctx, doc); } } @@ -58,8 +58,8 @@ export class SubDeclarationElement extends DeclarationElement implements HasSymb constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: SubroutineDeclarationContext) { super(context, document); - const identifierContext = methodContext.subroutineName()!.ambiguousIdentifier()!; - this.identifier = new IdentifierElement(identifierContext, document); + const identifierContext = methodContext.subroutineName()?.ambiguousIdentifier(); + this.identifier = new IdentifierElement(identifierContext!, document); this.symbolInformation = SymbolInformation.create( this.identifier.text, SymbolKind.Method, @@ -207,84 +207,6 @@ class EnumMemberDeclarationElement extends BaseEnumDeclarationElement { } } - -// abstract class BaseEnumElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { -// identifier: IdentifierElement; -// tokenModifiers: SemanticTokenModifiers[] = []; -// abstract tokenType: SemanticTokenTypes; -// abstract symbolKind: SymbolKind; - -// constructor(context: EnumerationStmtContext | EnumerationStmt_ConstantContext, document: TextDocument) { -// super(context, document); -// this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); -// } - -// get name(): string { return this.identifier.text; } -// get symbolInformation(): SymbolInformation { -// return SymbolInformationFactory.create( -// this, this.symbolKind -// ); -// } - -// } - - -// export class EnumBlockDeclarationElement extends BaseEnumElement { -// tokenType: SemanticTokenTypes; -// tokenModifiers: SemanticTokenModifiers[] = []; -// symbolKind: SymbolKind; - -// constructor(context: EnumerationStmtContext, document: TextDocument) { -// super(context, document); -// this.tokenType = SemanticTokenTypes.enum; -// this.symbolKind = SymbolKind.Enum; -// } -// } - - -// export class EnumMemberDeclarationElement extends BaseEnumElement { -// tokenType: SemanticTokenTypes; -// tokenModifiers: SemanticTokenModifiers[] = []; -// symbolKind: SymbolKind; - -// constructor(context: EnumerationStmt_ConstantContext, document: TextDocument) { -// super(context, document); -// this.tokenType = SemanticTokenTypes.enumMember; -// this.symbolKind = SymbolKind.EnumMember; -// } -// } - -// abstract class BaseMethodElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { -// identifier: IdentifierElement; -// tokenModifiers: SemanticTokenModifiers[] = []; -// abstract tokenType: SemanticTokenTypes; -// abstract symbolKind: SymbolKind; - -// constructor(context: MethodStmtContext, document: TextDocument) { -// super(context, document); -// this.identifier = new IdentifierElement(context.methodSignatureStmt().ambiguousIdentifier(), document); -// } - -// get name(): string { return this.identifier.text; } -// get symbolInformation(): SymbolInformation { -// return SymbolInformationFactory.create( -// this, this.symbolKind -// ); -// } -// } - -// export class MethodBlockDeclarationElement extends BaseMethodElement { -// tokenType: SemanticTokenTypes; -// tokenModifiers: SemanticTokenModifiers[] = []; -// symbolKind: SymbolKind; - -// constructor(context: MethodStmtContext, document: TextDocument) { -// super(context, document); -// this.tokenType = SemanticTokenTypes.method; -// this.symbolKind = SymbolKind.Method; -// } -// } - // abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntaxElement { // abstract declarations: VariableDeclarationElement[]; @@ -306,25 +228,27 @@ class EnumMemberDeclarationElement extends BaseEnumDeclarationElement { // } // } -// export class TypeDeclarationElement extends FoldableElement implements HasSemanticToken, HasSymbolInformation { -// tokenType: SemanticTokenTypes; -// tokenModifiers: SemanticTokenModifiers[] = []; -// identifier: IdentifierElement; -// symbolKind: SymbolKind; +export class TypeDeclarationElement extends ScopeElement implements HasSemanticToken, HasSymbolInformation, NamedSyntaxElement { + tokenType: SemanticTokenTypes; + tokenModifiers: SemanticTokenModifiers[] = []; + identifier: IdentifierElement; + symbolKind: SymbolKind; + declaredNames: Map = new Map(); // Get variable declarations going -// constructor(context: TypeStmtContext, document: TextDocument) { -// super(context, document); -// this.symbolKind = SymbolKind.Struct; -// this.tokenType = SemanticTokenTypes.struct; -// this.identifier = new IdentifierElement(context.ambiguousIdentifier(), document); -// } + constructor(context: UdtDeclarationContext, document: TextDocument) { + super(context, document); + this.symbolKind = SymbolKind.Struct; + this.tokenType = SemanticTokenTypes.struct; + this.identifier = new IdentifierElement(context.untypedName(), document); + } -// get name(): string { return this.identifier.text; } -// get symbolInformation(): SymbolInformation { -// return SymbolInformationFactory.create( -// this, this.symbolKind -// ); -// } + get name(): string { return this.identifier.text; } + get symbolInformation(): SymbolInformation { + return SymbolInformationFactory.create( + this as NamedSyntaxElement, this.symbolKind + ); + } +} // } diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index cfb8895..94d2f4b 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,15 +1,15 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, WhileStatementContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, UdtDeclarationContext, WhileStatementContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; -import { CharStream, CommonTokenStream, DefaultErrorStrategy, ParseTreeWalker, Parser, RecognitionException } from 'antlr4ng'; +import { CharStream, CommonTokenStream, DefaultErrorStrategy, ErrorNode, ParseTreeWalker, Parser, RecognitionException } from 'antlr4ng'; import { ClassElement, IgnoredAttributeElement, ModuleElement } from '../elements/module'; -import { DeclarationElement, EnumDeclarationElement } from '../elements/memory'; +import { DeclarationElement, EnumDeclarationElement, TypeDeclarationElement } from '../elements/memory'; import { WhileLoopElement } from '../elements/flow'; export class SyntaxParser { @@ -150,6 +150,13 @@ class VbaListener extends vbaListener { this.document.deregisterScopedElement(); }; + enterUdtDeclaration = (ctx: UdtDeclarationContext) => { + const element = new TypeDeclarationElement(ctx, this.document.textDocument); + this.document.registerFoldableElement(element) + .registerSemanticToken(element) + .registerSymbolInformation(element); + }; + enterWhileStatement = (ctx: WhileStatementContext) => { const element = new WhileLoopElement(ctx, this.document.textDocument); this.document.registerDiagnosticElement(element); @@ -167,61 +174,6 @@ class VbaListener extends vbaListener { // const element = new ConstDeclarationsElement(ctx, this.document.textDocument); // element.declarations.forEach((e) => this.document.registerSymbolInformation(e)); // }; - - // enterEnumerationStmt = (ctx: EnumerationStmtContext) => { - // const element = new EnumBlockDeclarationElement(ctx, this.document.textDocument); - // this.document.registerFoldableElement(element) - // .registerSemanticToken(element) - // .registerSymbolInformation(element) - // .registerScopedElement(element); - // }; - - // exitEnumerationStmt = (_: EnumerationStmtContext) => { - // this.document.deregisterScopedElement(); - // }; - - // enterEnumerationStmt_Constant = (ctx: EnumerationStmt_ConstantContext) => { - // const element = new EnumMemberDeclarationElement(ctx, this.document.textDocument); - // this.document.registerSymbolInformation(element) - // .registerSemanticToken(element); - // }; - - // enterFoldingBlockStmt = (ctx: FoldingBlockStmtContext) => { - // const element = new FoldableElement(ctx, this.document.textDocument); - // this.document.registerFoldableElement(element); - // }; - - // enterMethodStmt = (ctx: MethodStmtContext) => { - // const element = new MethodBlockDeclarationElement(ctx, this.document.textDocument); - // this.document.registerNamedElement(element) - // .registerFoldableElement(element) - // .registerSymbolInformation(element) - // .registerSemanticToken(element) - // .registerScopedElement(element); - // }; - - // exitMethodStmt = (_: MethodStmtContext) => { - // this.document.deregisterScopedElement(); - // }; - - // enterModule = (ctx: ModuleContext) => { - // const element = new ModuleElement(ctx, this.document.textDocument, this.document.symbolKind); - // this.document.registerAttributeElement(element) - // .registerDiagnosticElement(element) - // .registerScopedElement(element); - // }; - - // exitModule = (_: ModuleContext) => { - // const element = this.document.deregisterAttributeElement() as ModuleElement; - // this.document.registerSymbolInformation(element) - // .deregisterScopedElement() - // .deregisterAttributeElement(); - // }; - - // enterModuleHeader = (ctx: ModuleHeaderContext) => { - // const element = new FoldableElement(ctx, this.document.textDocument); - // this.document.registerFoldableElement(element); - // }; // enterOperatorsStmt = (ctx: OperatorsStmtContext) => { // const element = new OperatorElement(ctx, this.document.textDocument); From 40bbe5c1f3d386d52d91d4f2533b45964dd40250 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 20:30:10 +0800 Subject: [PATCH 55/61] Support for constants --- server/src/project/elements/base.ts | 2 +- server/src/project/elements/memory.ts | 54 ++++++++++++++------ server/src/project/parser/vbaSyntaxParser.ts | 6 +++ 3 files changed, 44 insertions(+), 18 deletions(-) diff --git a/server/src/project/elements/base.ts b/server/src/project/elements/base.ts index 75284f7..01497dd 100644 --- a/server/src/project/elements/base.ts +++ b/server/src/project/elements/base.ts @@ -34,7 +34,7 @@ export interface IdentifiableSyntaxElement extends NamedSyntaxElement { } export interface HasSymbolInformation extends NamedSyntaxElement { - symbolInformation: SymbolInformation; + get symbolInformation(): SymbolInformation; } export interface HasSemanticToken extends NamedSyntaxElement, IdentifiableSyntaxElement { diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index a70fd40..b6b3aea 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -207,26 +207,46 @@ class EnumMemberDeclarationElement extends BaseEnumDeclarationElement { } } -// abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntaxElement { -// abstract declarations: VariableDeclarationElement[]; +abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntaxElement implements HasSemanticToken, HasSymbolInformation, NamedSyntaxElement { + tokenType: SemanticTokenTypes; + tokenModifiers: SemanticTokenModifiers[] = []; + readonly symbolKind: SymbolKind; + + abstract identifier: IdentifierElement; -// constructor(context: ConstStmtContext | VariableStmtContext, document: TextDocument) { -// super(context, document); -// } -// } + get name(): string { + return this.identifier.text; + } -// export class ConstDeclarationsElement extends BaseVariableDeclarationStatementElement { -// declarations: VariableDeclarationElement[] = []; + get symbolInformation(): SymbolInformation { + return SymbolInformation.create( + this.identifier.text, + this.symbolKind, + this.range, + this.document.uri + ); + } -// constructor(context: ConstStmtContext, document: TextDocument) { -// super(context, document); -// context.constSubStmt().forEach((element) => -// this.declarations.push(new VariableDeclarationElement( -// element, document -// )) -// ); -// } -// } + constructor(context: VariableDclContext | ConstItemContext | UdtElementContext, document: TextDocument, tokenType: SemanticTokenTypes, symbolKind: SymbolKind) { + super(context, document); + this.tokenType = tokenType; + this.symbolKind = symbolKind; + } +} + +export class ConstDeclarationElement extends BaseVariableDeclarationStatementElement { + tokenModifiers: SemanticTokenModifiers[] = []; + identifier: IdentifierElement; + + get name(): string { + return this.identifier.text; + } + + constructor(context: ConstItemContext, document: TextDocument) { + super(context, document, SemanticTokenTypes.variable, SymbolKind.Constant); + this.identifier = new IdentifierElement(context, document); + } +} export class TypeDeclarationElement extends ScopeElement implements HasSemanticToken, HasSymbolInformation, NamedSyntaxElement { tokenType: SemanticTokenTypes; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index 94d2f4b..fbc04a9 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -121,6 +121,12 @@ class VbaListener extends vbaListener { this.document.deregisterScopedElement(); }; + enterConstItem = (ctx: ConstItemContext) => { + const element = new ConstDeclarationElement(ctx, this.document.textDocument); + this.document.registerSemanticToken(element) + .registerSymbolInformation(element); + }; + enterIgnoredAttr = (ctx: IgnoredAttrContext) => { const element = new IgnoredAttributeElement(ctx, this.document.textDocument); this.document.registerDiagnosticElement(element); From f357e1524896fdf6b3443c1a5929478a5cda5d31 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 20:30:20 +0800 Subject: [PATCH 56/61] Support for Type declarations --- server/src/project/elements/memory.ts | 31 +++++++++++++++----- server/src/project/parser/vbaSyntaxParser.ts | 9 ++++-- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index b6b3aea..894f0bf 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,17 +1,18 @@ -import { AmbiguousIdentifierContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, PublicTypeDeclarationContext, SubroutineDeclarationContext, UdtDeclarationContext, UntypedNameContext } from '../../antlr/out/vbaParser'; - import { TextDocument } from 'vscode-languageserver-textdocument'; +import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; +import { AmbiguousIdentifierContext, ConstItemContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, ReservedMemberNameContext, SubroutineDeclarationContext, UdtDeclarationContext, UdtElementContext, UntypedNameContext, VariableDclContext } from '../../antlr/out/vbaParser'; import { BaseContextSyntaxElement, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, NamedSyntaxElement } from './base'; -import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; + import { ScopeElement } from './special'; +import { VbaClassDocument, VbaModuleDocument } from '../document'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import '../../extensions/parserExtensions'; -import { VbaClassDocument, VbaModuleDocument } from '../document'; + export class IdentifierElement extends BaseContextSyntaxElement { - constructor(ctx: UntypedNameContext | AmbiguousIdentifierContext, doc: TextDocument) { + constructor(ctx: UntypedNameContext | ConstItemContext | AmbiguousIdentifierContext | ReservedMemberNameContext, doc: TextDocument) { super(ctx, doc); } } @@ -253,13 +254,16 @@ export class TypeDeclarationElement extends ScopeElement implements HasSemantic tokenModifiers: SemanticTokenModifiers[] = []; identifier: IdentifierElement; symbolKind: SymbolKind; - declaredNames: Map = new Map(); // Get variable declarations going + declaredNames: Map = new Map(); constructor(context: UdtDeclarationContext, document: TextDocument) { super(context, document); this.symbolKind = SymbolKind.Struct; this.tokenType = SemanticTokenTypes.struct; this.identifier = new IdentifierElement(context.untypedName(), document); + context.udtMemberList().udtElement().forEach(member => + this._pushDeclaredName(new TypeMemberDeclarationElement(member, document)) + ); } get name(): string { return this.identifier.text; } @@ -270,7 +274,20 @@ export class TypeDeclarationElement extends ScopeElement implements HasSemantic } } -// } +export class TypeMemberDeclarationElement extends BaseVariableDeclarationStatementElement { + tokenModifiers: SemanticTokenModifiers[] = []; + identifier: IdentifierElement; + + get name(): string { + return this.identifier.text; + } + + constructor(context: UdtElementContext, document: TextDocument) { + super(context, document, SemanticTokenTypes.property, SymbolKind.Property); + const identifierContext = context.udtMember()?.untypedNameMemberDcl()?.ambiguousIdentifier() ?? context.udtMember()?.reservedNameMemberDcl()?.reservedMemberName(); + this.identifier = new IdentifierElement(identifierContext!, document); + } +} // export class VariableDeclarationsElement extends BaseVariableDeclarationStatementElement { // declarations: VariableDeclarationElement[] = []; diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index fbc04a9..b5d494f 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -1,7 +1,7 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { vbaLexer } from '../../antlr/out/vbaLexer'; -import { ClassModuleContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProcedureDeclarationContext, UdtDeclarationContext, WhileStatementContext, vbaParser } from '../../antlr/out/vbaParser'; +import { ClassModuleContext, ConstItemContext, EnumDeclarationContext, IgnoredAttrContext, ProceduralModuleContext, ProceduralModuleDeclarationElementContext, ProcedureDeclarationContext, UdtDeclarationContext, WhileStatementContext, vbaParser } from '../../antlr/out/vbaParser'; import { vbaListener } from '../../antlr/out/vbaListener'; import { VbaClassDocument, VbaModuleDocument } from '../document'; @@ -9,7 +9,7 @@ import { sleep } from '../../utils/helpers'; import { CancellationToken } from 'vscode-languageserver'; import { CharStream, CommonTokenStream, DefaultErrorStrategy, ErrorNode, ParseTreeWalker, Parser, RecognitionException } from 'antlr4ng'; import { ClassElement, IgnoredAttributeElement, ModuleElement } from '../elements/module'; -import { DeclarationElement, EnumDeclarationElement, TypeDeclarationElement } from '../elements/memory'; +import { ConstDeclarationElement, DeclarationElement, EnumDeclarationElement, TypeDeclarationElement } from '../elements/memory'; import { WhileLoopElement } from '../elements/flow'; export class SyntaxParser { @@ -161,6 +161,11 @@ class VbaListener extends vbaListener { this.document.registerFoldableElement(element) .registerSemanticToken(element) .registerSymbolInformation(element); + element.declaredNames.forEach(names => + names.forEach(name => this.document + .registerSemanticToken(name) + .registerSymbolInformation(name)) + ); }; enterWhileStatement = (ctx: WhileStatementContext) => { From 2cd6f20af4a9276a3cf44cce5648a34b803ff71b Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 22:22:56 +0800 Subject: [PATCH 57/61] Enable duplicate property declaration diagnostics --- server/src/capabilities/diagnostics.ts | 8 +++ server/src/project/document.ts | 5 +- server/src/project/elements/base.ts | 4 +- server/src/project/elements/memory.ts | 73 +++++++++++++++----- server/src/project/elements/special.ts | 7 +- server/src/project/parser/vbaSyntaxParser.ts | 5 +- 6 files changed, 80 insertions(+), 22 deletions(-) diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 4befea3..0263d96 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -60,6 +60,14 @@ export class DuplicateAttributeDiagnostic extends BaseDiagnostic { } } +export class DuplicateDeclarationDiagnostic extends BaseDiagnostic { + message = "Duplicate declaration in current scope"; + severity = DiagnosticSeverity.Error; + constructor(range: Range) { + super(range); + } +} + export class IgnoredAttributeDiagnostic extends BaseDiagnostic { message = "This attribute will be ignored."; severity = DiagnosticSeverity.Information; diff --git a/server/src/project/document.ts b/server/src/project/document.ts index f695e8d..5fbc80b 100644 --- a/server/src/project/document.ts +++ b/server/src/project/document.ts @@ -1,7 +1,7 @@ import { CancellationToken, Diagnostic, PublishDiagnosticsParams, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { Workspace } from './workspace'; import { FoldableElement } from './elements/special'; -import { BaseSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, ScopeElement } from './elements/base'; +import { BaseSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, ScopeElement } from './elements/base'; import { Range, TextDocument } from 'vscode-languageserver-textdocument'; import { SyntaxParser } from './parser/vbaSyntaxParser'; import { FoldingRange } from '../capabilities/folding'; @@ -147,7 +147,8 @@ export abstract class BaseProjectDocument { return this; }; - registerNamedElement(element: BaseSyntaxElement) { + registerNamedElement(element: IdentifiableSyntaxElement) { + this.currentScopeElement?.pushDeclaredName(element); return this; } diff --git a/server/src/project/elements/base.ts b/server/src/project/elements/base.ts index 01497dd..d521eb5 100644 --- a/server/src/project/elements/base.ts +++ b/server/src/project/elements/base.ts @@ -2,7 +2,7 @@ import { ParserRuleContext } from 'antlr4ng'; import { Diagnostic, Range, SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { Position, TextDocument } from 'vscode-languageserver-textdocument'; import { FoldingRangeKind } from '../../capabilities/folding'; -import { IdentifierElement } from './memory'; +import { IdentifierElement, PropertyDeclarationElement } from './memory'; import '../../extensions/parserExtensions'; export interface ContextOptionalSyntaxElement { @@ -31,6 +31,7 @@ export interface NamedSyntaxElement extends SyntaxElement { export interface IdentifiableSyntaxElement extends NamedSyntaxElement { identifier: IdentifierElement; + isPropertyElement(): this is PropertyDeclarationElement } export interface HasSymbolInformation extends NamedSyntaxElement { @@ -55,6 +56,7 @@ export interface FoldingRangeElement { export interface ScopeElement { declaredNames: Map; + pushDeclaredName(element: IdentifiableSyntaxElement): void } export abstract class BaseSyntaxElement implements ContextOptionalSyntaxElement { diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 894f0bf..3d54c8b 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -1,13 +1,14 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; -import { SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; +import { Diagnostic, SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { AmbiguousIdentifierContext, ConstItemContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, ReservedMemberNameContext, SubroutineDeclarationContext, UdtDeclarationContext, UdtElementContext, UntypedNameContext, VariableDclContext } from '../../antlr/out/vbaParser'; -import { BaseContextSyntaxElement, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, NamedSyntaxElement } from './base'; +import { BaseContextSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, NamedSyntaxElement } from './base'; import { ScopeElement } from './special'; -import { VbaClassDocument, VbaModuleDocument } from '../document'; +import { BaseProjectDocument, VbaClassDocument, VbaModuleDocument } from '../document'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import '../../extensions/parserExtensions'; +import { DuplicateDeclarationDiagnostic } from '../../capabilities/diagnostics'; @@ -17,44 +18,59 @@ export class IdentifierElement extends BaseContextSyntaxElement { } } -export abstract class DeclarationElement extends ScopeElement { +export abstract class DeclarationElement extends ScopeElement implements HasDiagnosticCapability { + abstract diagnostics: Diagnostic[]; abstract identifier: IdentifierElement; constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); } + + evaluateDiagnostics(): void { + return; + } + get name(): string { throw new Error('Method not implemented.'); } static create(context: ProcedureDeclarationContext, document: VbaClassDocument | VbaModuleDocument) { let methodContext: SubroutineDeclarationContext | FunctionDeclarationContext | PropertyGetDeclarationContext | null; + + // Create a sub if we have one. methodContext = context.subroutineDeclaration(); if (methodContext) { return new SubDeclarationElement(context, document.textDocument, methodContext); } + // Create a function if we have one. methodContext = context.functionDeclaration(); if (methodContext) { return new FunctionDeclarationElement(context, document.textDocument, methodContext); } + // Check if we already have a property with this name. const propertyDeclaration = new PropertyDeclarationElement(context, document.textDocument); - const predeclaredElements = document.currentScopeElement?.declaredNames.get(propertyDeclaration.identifier.text); - predeclaredElements?.forEach(predeclaredElement => { - if (predeclaredElement && isPropertyDeclarationElement(predeclaredElement)) { - predeclaredElement.addPropertyDeclaration(context, document.textDocument); - return predeclaredElement; + const identifierText = propertyDeclaration.identifier.text; + const predeclaredElements = document.currentScopeElement?.declaredNames.get(identifierText) ?? []; + + // Add to an existing property rather than creating. + for (const element of predeclaredElements) { + if (element.isPropertyElement() && element.identifier.text === identifierText) { + element.addPropertyDeclaration(context, document.textDocument); + return element; } - }); + } + + // Return a new property. return propertyDeclaration; } - } export class SubDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; symbolInformation: SymbolInformation; + diagnostics: Diagnostic[] = []; constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: SubroutineDeclarationContext) { super(context, document); @@ -73,6 +89,7 @@ export class SubDeclarationElement extends DeclarationElement implements HasSymb export class FunctionDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; symbolInformation: SymbolInformation; + diagnostics: Diagnostic[] = []; constructor(context: ProcedureDeclarationContext, document: TextDocument, methodContext: FunctionDeclarationContext) { super(context, document); @@ -89,11 +106,18 @@ export class FunctionDeclarationElement extends DeclarationElement implements Ha export class PropertyDeclarationElement extends DeclarationElement implements HasSymbolInformation { identifier: IdentifierElement; + diagnostics: Diagnostic[] = []; symbolInformation: SymbolInformation; getDeclarations: PropertyGetDeclarationElement[] = []; letDeclarations: PropertyLetDeclarationElement[] = []; setDeclarations: PropertyLetDeclarationElement[] = []; + get countDeclarations(): number { + return this.getDeclarations.length + + this.letDeclarations.length + + this.setDeclarations.length; + } + constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); this.identifier = this.addPropertyDeclaration(context, document); @@ -105,6 +129,10 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha ); } + evaluateDiagnostics(): void { + this._evaluateDuplicateDeclarationsDiagnostics(); + } + addPropertyDeclaration(context: ProcedureDeclarationContext, document: TextDocument) { switch (true) { case !!context.propertyGetDeclaration(): @@ -121,10 +149,19 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha return this.setDeclarations[0].identifier; } } + + private _evaluateDuplicateDeclarationsDiagnostics(): void { + [this.getDeclarations, this.letDeclarations, this.setDeclarations].forEach(declarations => { + declarations.forEach((declaration, i) => { + if (i > 0) this.diagnostics.push(new DuplicateDeclarationDiagnostic(declaration.identifier.range)); + }); + }); + } } class PropertyGetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; + diagnostics: Diagnostic[] = []; constructor(context: ProcedureDeclarationContext, document: TextDocument, getContext: PropertyGetDeclarationContext) { super(context, document); @@ -134,6 +171,7 @@ class PropertyGetDeclarationElement extends DeclarationElement { class PropertyLetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; + diagnostics: Diagnostic[] = []; constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); @@ -143,6 +181,7 @@ class PropertyLetDeclarationElement extends DeclarationElement { class PropertySetDeclarationElement extends DeclarationElement { identifier: IdentifierElement; + diagnostics: Diagnostic[] = []; constructor(context: ProcedureDeclarationContext, document: TextDocument, setContext: PropertySetDeclarationContext) { super(context, document); @@ -150,10 +189,6 @@ class PropertySetDeclarationElement extends DeclarationElement { } } -function isPropertyDeclarationElement(element: IdentifiableSyntaxElement): element is PropertyDeclarationElement { - return 'getDeclarations' in element; -} - abstract class BaseEnumDeclarationElement extends ScopeElement implements HasSemanticToken, HasSymbolInformation { identifier: IdentifierElement; tokenModifiers: SemanticTokenModifiers[] = []; @@ -181,7 +216,7 @@ export class EnumDeclarationElement extends BaseEnumDeclarationElement implement this.tokenType = SemanticTokenTypes.enum; this.identifier = new IdentifierElement(context.untypedName().ambiguousIdentifier()!, document); context.enumMemberList().enumElement().forEach(enumElementContext => - this._pushDeclaredName(new EnumMemberDeclarationElement(enumElementContext.enumMember()!, document)) + this.pushDeclaredName(new EnumMemberDeclarationElement(enumElementContext.enumMember()!, document)) ); } @@ -228,6 +263,10 @@ abstract class BaseVariableDeclarationStatementElement extends BaseContextSyntax ); } + isPropertyElement(): this is PropertyDeclarationElement { + return false; + } + constructor(context: VariableDclContext | ConstItemContext | UdtElementContext, document: TextDocument, tokenType: SemanticTokenTypes, symbolKind: SymbolKind) { super(context, document); this.tokenType = tokenType; @@ -262,7 +301,7 @@ export class TypeDeclarationElement extends ScopeElement implements HasSemantic this.tokenType = SemanticTokenTypes.struct; this.identifier = new IdentifierElement(context.untypedName(), document); context.udtMemberList().udtElement().forEach(member => - this._pushDeclaredName(new TypeMemberDeclarationElement(member, document)) + this.pushDeclaredName(new TypeMemberDeclarationElement(member, document)) ); } diff --git a/server/src/project/elements/special.ts b/server/src/project/elements/special.ts index 7cd6c36..6f12f16 100644 --- a/server/src/project/elements/special.ts +++ b/server/src/project/elements/special.ts @@ -2,6 +2,7 @@ import { ParserRuleContext } from 'antlr4ng'; import { FoldingRangeKind } from '../../capabilities/folding'; import { BaseContextSyntaxElement, FoldingRangeElement, IdentifiableSyntaxElement } from './base'; import { Range, TextDocument } from 'vscode-languageserver-textdocument'; +import { PropertyDeclarationElement } from './memory'; export class FoldableElement extends BaseContextSyntaxElement implements FoldingRangeElement { @@ -21,10 +22,14 @@ export class ScopeElement extends FoldableElement implements ScopeElement { super(ctx, doc); } - protected _pushDeclaredName(element: IdentifiableSyntaxElement) { + pushDeclaredName(element: IdentifiableSyntaxElement): void { const name = element.identifier.text; const names: IdentifiableSyntaxElement[] = this.declaredNames.get(name) ?? []; names.push(element); this.declaredNames.set(name, names); } + + isPropertyElement(): this is PropertyDeclarationElement { + return 'getDeclarations' in this; + } } diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index b5d494f..cd8603c 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -144,12 +144,15 @@ class VbaListener extends vbaListener { }; enterProcedureDeclaration = (ctx: ProcedureDeclarationContext) => { - // TODO: figure out how to handle scope for properties. const element = DeclarationElement.create(ctx, this.document); this.document.registerSymbolInformation(element) .registerFoldableElement(element) .registerNamedElement(element) .registerScopedElement(element); + + if (element.isPropertyElement() && element.countDeclarations === 1) { + this.document.registerDiagnosticElement(element); + } }; exitProcedureDeclaration = (ctx: ProcedureDeclarationContext) => { From 402381ae0751e099087857538934814baeee680b Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 22:24:42 +0800 Subject: [PATCH 58/61] Only register property name once --- server/src/project/parser/vbaSyntaxParser.ts | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index cd8603c..dce02b9 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -147,11 +147,11 @@ class VbaListener extends vbaListener { const element = DeclarationElement.create(ctx, this.document); this.document.registerSymbolInformation(element) .registerFoldableElement(element) - .registerNamedElement(element) .registerScopedElement(element); if (element.isPropertyElement() && element.countDeclarations === 1) { - this.document.registerDiagnosticElement(element); + this.document.registerDiagnosticElement(element) + .registerNamedElement(element); } }; From ff8d98ec9fa189981df97e78e0eba35291d8cf6e Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 22:41:32 +0800 Subject: [PATCH 59/61] Added property type to name in SymbolInformation --- server/src/project/elements/memory.ts | 29 +++++++++++++++++---------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/server/src/project/elements/memory.ts b/server/src/project/elements/memory.ts index 3d54c8b..e73ca83 100644 --- a/server/src/project/elements/memory.ts +++ b/server/src/project/elements/memory.ts @@ -2,10 +2,10 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; import { Diagnostic, SemanticTokenModifiers, SemanticTokenTypes, SymbolInformation, SymbolKind } from 'vscode-languageserver'; import { AmbiguousIdentifierContext, ConstItemContext, EnumDeclarationContext, EnumMemberContext, FunctionDeclarationContext, ProcedureDeclarationContext, PropertyGetDeclarationContext, PropertySetDeclarationContext, ReservedMemberNameContext, SubroutineDeclarationContext, UdtDeclarationContext, UdtElementContext, UntypedNameContext, VariableDclContext } from '../../antlr/out/vbaParser'; -import { BaseContextSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, IdentifiableSyntaxElement, NamedSyntaxElement } from './base'; +import { BaseContextSyntaxElement, HasDiagnosticCapability, HasSemanticToken, HasSymbolInformation, NamedSyntaxElement } from './base'; import { ScopeElement } from './special'; -import { BaseProjectDocument, VbaClassDocument, VbaModuleDocument } from '../document'; +import { VbaClassDocument, VbaModuleDocument } from '../document'; import { SymbolInformationFactory } from '../../capabilities/symbolInformation'; import '../../extensions/parserExtensions'; import { DuplicateDeclarationDiagnostic } from '../../capabilities/diagnostics'; @@ -120,9 +120,10 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha constructor(context: ProcedureDeclarationContext, document: TextDocument) { super(context, document); - this.identifier = this.addPropertyDeclaration(context, document); + const identifier = this.addPropertyDeclaration(context, document); + this.identifier = identifier.value this.symbolInformation = SymbolInformation.create( - this.identifier.text, + `${identifier.type} ${this.identifier.text}`, SymbolKind.Property, this.range, this.document.uri @@ -134,20 +135,26 @@ export class PropertyDeclarationElement extends DeclarationElement implements Ha } addPropertyDeclaration(context: ProcedureDeclarationContext, document: TextDocument) { + let property: PropertyGetDeclarationElement | PropertyLetDeclarationElement | PropertySetDeclarationElement; + let propertyType: string; switch (true) { case !!context.propertyGetDeclaration(): - // Property Get + propertyType = 'Get'; + property = new PropertyGetDeclarationElement(context, document, context.propertyGetDeclaration()!); this.getDeclarations.push(new PropertyGetDeclarationElement(context, document, context.propertyGetDeclaration()!)); - return this.getDeclarations[0].identifier; + break; case !!context.propertySetDeclaration()?.LET(): - // Property Let - this.letDeclarations.push(new PropertyLetDeclarationElement(context, document, context.propertySetDeclaration()!)); - return this.letDeclarations[0].identifier; + propertyType = 'Let'; + property = new PropertyLetDeclarationElement(context, document, context.propertySetDeclaration()!); + this.letDeclarations.push(property); + break; default: - // Property Set + propertyType = 'Set'; + property = new PropertyLetDeclarationElement(context, document, context.propertySetDeclaration()!); this.setDeclarations.push(new PropertySetDeclarationElement(context, document, context.propertySetDeclaration()!)); - return this.setDeclarations[0].identifier; + break; } + return { type: propertyType, value: property.identifier }; } private _evaluateDuplicateDeclarationsDiagnostics(): void { From fa1e5af6899fa6800246af0b8f14c79e45c53fe5 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 23:46:43 +0800 Subject: [PATCH 60/61] Methods now parse with args out of order --- server/src/antlr/vba.g4 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/server/src/antlr/vba.g4 b/server/src/antlr/vba.g4 index 60c6abf..1de110e 100644 --- a/server/src/antlr/vba.g4 +++ b/server/src/antlr/vba.g4 @@ -441,12 +441,23 @@ arrayDesignator: '(' wsc? ')'; // 5.3.1.5 Parameter Lists procedureParameters: '(' wsc? parameterList? wsc? ')'; propertyParameters: '(' wsc? (parameterList wsc? ',' wsc?)? valueParam wsc? ')'; -parameterList +validParameterList : (positionalParameters wsc? ',' wsc? optionalParameters) | (positionalParameters (wsc? ',' wsc? paramArray)?) | optionalParameters | paramArray ; +invalidParameterList + : anyParam (wsc? ',' wsc? anyParam)* + ; + +parameterList: (validParameterList | invalidParameterList); + +anyParam + : positionalParam + | optionalParam + | paramArray + ; positionalParameters: positionalParam (wsc? ',' wsc? positionalParam)*; optionalParameters: optionalParam (wsc? ',' wsc? optionalParam)*; From f7d7bff7ace81c11b726d240ae54423da89a3359 Mon Sep 17 00:00:00 2001 From: sslinky Date: Tue, 4 Jun 2024 23:48:02 +0800 Subject: [PATCH 61/61] Increased file max size --- server/src/project/parser/vbaSyntaxParser.ts | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src/project/parser/vbaSyntaxParser.ts b/server/src/project/parser/vbaSyntaxParser.ts index dce02b9..304e5ff 100644 --- a/server/src/project/parser/vbaSyntaxParser.ts +++ b/server/src/project/parser/vbaSyntaxParser.ts @@ -34,7 +34,7 @@ export class SyntaxParser { // }); // Refuse to do anything that seems like too much work. - if (document.textDocument.lineCount > 1500) { + if (document.textDocument.lineCount > 2000) { // TODO: Make this an option that people can increase or decrease. console.log(`Document oversize: ${document.textDocument.lineCount} lines.`); console.warn(`Syntax parsing has been disabled to prevent crashing.`);