├── COPYING ├── README.md ├── Sample-Formatting.cfg ├── images └── vscodedebug.png └── src ├── pascallanguageserver.lpg ├── protocol ├── LSP.Base.pas ├── LSP.BaseTypes.pas ├── LSP.Basic.pas ├── LSP.Capabilities.pas ├── LSP.CodeAction.pas ├── LSP.Completion.pas ├── LSP.Diagnostics.pas ├── LSP.DocumentHighlight.pas ├── LSP.DocumentSymbol.pas ├── LSP.ExecuteCommand.pas ├── LSP.General.pas ├── LSP.Hover.pas ├── LSP.InlayHint.pas ├── LSP.Messages.pas ├── LSP.Options.pas ├── LSP.References.pas ├── LSP.SignatureHelp.pas ├── LSP.Streaming.pas ├── LSP.Synchronization.pas ├── LSP.Window.pas ├── LSP.WorkDoneProgress.pas ├── LSP.Workspace.pas ├── PasLS.Settings.pas ├── PasLS.SocketDispatcher.pas ├── PasLS.TextLoop.pas ├── lspprotocol.lpk ├── lspprotocol.pas └── memutils.pas ├── proxy ├── PasLSProxy.Config.pas ├── paslsproxy.lpi └── paslsproxy.lpr ├── serverprotocol ├── PasLS.AllCommands.pas ├── PasLS.ApplyEdit.pas ├── PasLS.CheckInactiveRegions.pas ├── PasLS.CodeAction.pas ├── PasLS.CodeUtils.pas ├── PasLS.Command.CompleteCode.pas ├── PasLS.Command.FormatCode.pas ├── PasLS.Command.InvertAssignment.pas ├── PasLS.Command.RemoveEmptyMethods.pas ├── PasLS.Commands.pas ├── PasLS.Completion.pas ├── PasLS.Diagnostics.pas ├── PasLS.DocumentHighlight.pas ├── PasLS.DocumentSymbol.pas ├── PasLS.ExecuteCommand.pas ├── PasLS.Formatter.pas ├── PasLS.General.pas ├── PasLS.GotoDeclaration.pas ├── PasLS.GotoDefinition.pas ├── PasLS.GotoImplementation.pas ├── PasLS.Hover.pas ├── PasLS.InactiveRegions.pas ├── PasLS.InlayHint.pas ├── PasLS.InvertAssign.pas ├── PasLS.LazConfig.pas ├── PasLS.Parser.pas ├── PasLS.References.pas ├── PasLS.RemoveEmptyMethods.pas ├── PasLS.Settings.pas ├── PasLS.SignatureHelp.pas ├── PasLS.Symbols.pas ├── PasLS.Synchronization.pas ├── PasLS.Workspace.pas ├── lspserver.lpk └── lspserver.pas ├── socketserver ├── PasLSSock.Config.pas ├── paslssock.lpi └── paslssock.lpr ├── standard ├── PasLS.LSConfig.pas ├── pasls.lpi └── pasls.lpr └── tests ├── Tests.Basic.pas ├── testlsp.lpi └── testlsp.lpr /images/vscodedebug.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/genericptr/pascal-language-server/5202e1a0c852f2dfe23825a060246978a49ecaf8/images/vscodedebug.png -------------------------------------------------------------------------------- /src/pascallanguageserver.lpg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /src/protocol/LSP.BaseTypes.pas: -------------------------------------------------------------------------------- 1 | // Copyright 2023 Michael Van Canneyt 2 | // This file is part of Pascal Language Server. 3 | 4 | // Pascal Language Server is free software: you can redistribute it 5 | // and/or modify it under the terms of the GNU General Public License 6 | // as published by the Free Software Foundation, either version 3 of 7 | // the License, or (at your option) any later version. 8 | 9 | // Pascal Language Server is distributed in the hope that it will be 10 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 11 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | // GNU General Public License for more details. 13 | 14 | // You should have received a copy of the GNU General Public License 15 | // along with Pascal Language Server. If not, see 16 | // . 17 | unit LSP.BaseTypes; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils; 25 | 26 | Type 27 | TAnyArray = array of Variant; 28 | 29 | { TOptional } 30 | 31 | generic TOptional = class 32 | private 33 | fHasValue: Boolean; 34 | fValue: T; 35 | function GetValue: T; 36 | procedure SetValue(AValue: T); 37 | public 38 | property HasValue: Boolean read fHasValue; 39 | property Value: T read GetValue write SetValue; 40 | procedure Clear; 41 | end; 42 | 43 | { TOptionalVariantBase } 44 | 45 | TOptionalVariantBase = class(specialize TOptional); 46 | 47 | { TOptionalVariant } 48 | 49 | generic TOptionalVariant = class(TOptionalVariantBase) 50 | private 51 | function GetValue: T; 52 | procedure SetValue(AValue: T); 53 | public 54 | constructor Create; overload; 55 | constructor Create(AValue: T); overload; 56 | property Value: T read GetValue write SetValue; 57 | end; 58 | 59 | { TOptionalObjectBase } 60 | 61 | TOptionalObjectBase = class(specialize TOptional) 62 | public 63 | function ValueClass: TClass; virtual; abstract; 64 | end; 65 | 66 | { TOptionalObject } 67 | 68 | generic TOptionalObject = class(TOptionalObjectBase) 69 | private 70 | function GetValue: T; 71 | procedure SetValue(AValue: T); 72 | public 73 | constructor Create; 74 | constructor Create(AValue: T); 75 | function ValueClass: TClass; override; 76 | property Value: T read GetValue write SetValue; 77 | end; 78 | 79 | TOptionalBoolean = specialize TOptionalVariant; 80 | TOptionalString = specialize TOptionalVariant; 81 | TOptionalInteger = specialize TOptionalVariant; 82 | TOptionalAny = specialize TOptionalVariant; // any type except structures (objects or arrays) 83 | TOptionalNumber = TOptionalInteger; 84 | 85 | { TGenericCollection } 86 | 87 | generic TGenericCollection = class(TCollection) 88 | private 89 | function GetI(Index : Integer): T; 90 | procedure SetI(Index : Integer; AValue: T); 91 | public 92 | constructor Create; 93 | Function Add : T; reintroduce; 94 | Property Items[Index : Integer] : T Read GetI Write SetI; 95 | end; 96 | 97 | { TLSPStreamable } 98 | 99 | TLSPStreamable = class(TPersistent) 100 | Public 101 | // We need a virtual constructor 102 | Constructor Create; virtual; 103 | end; 104 | TLSPStreamableClass = Class of TLSPStreamable; 105 | 106 | 107 | { LSPException } 108 | 109 | LSPException = class(Exception) 110 | public 111 | function Code: Integer; virtual; abstract; 112 | end; 113 | 114 | EServerNotInitialized = class(LSPException) 115 | public 116 | function Code: Integer; override; 117 | end; 118 | 119 | EUnknownErrorCode = class(LSPException) 120 | public 121 | function Code: Integer; override; 122 | end; 123 | 124 | // Defined by the protocol. 125 | ERequestCancelled = class(LSPException) 126 | public 127 | function Code: Integer; override; 128 | end; 129 | 130 | EContentModified = class(LSPException) 131 | public 132 | function Code: Integer; override; 133 | end; 134 | 135 | operator :=(right: Boolean): TOptionalAny; 136 | operator :=(right: Integer): TOptionalAny; 137 | operator :=(right: String): TOptionalAny; 138 | 139 | operator :=(right: Boolean): TOptionalBoolean; 140 | operator :=(right: Integer): TOptionalInteger; 141 | operator :=(right: String): TOptionalString; 142 | 143 | 144 | implementation 145 | 146 | { Utilities } 147 | 148 | operator :=(right: Boolean): TOptionalAny; 149 | begin 150 | result := TOptionalAny.Create(right); 151 | end; 152 | 153 | operator :=(right: Integer): TOptionalAny; 154 | begin 155 | result := TOptionalAny.Create(right); 156 | end; 157 | 158 | operator :=(right: String): TOptionalAny; 159 | begin 160 | result := TOptionalAny.Create(right); 161 | end; 162 | 163 | operator :=(right: Boolean): TOptionalBoolean; 164 | begin 165 | result := TOptionalBoolean.Create(right); 166 | end; 167 | 168 | operator :=(right: Integer): TOptionalInteger; 169 | begin 170 | result := TOptionalInteger.Create(right); 171 | end; 172 | 173 | operator :=(right: String): TOptionalString; 174 | begin 175 | result := TOptionalString.Create(right); 176 | end; 177 | 178 | 179 | { TOptional } 180 | 181 | function TOptional.GetValue: T; 182 | begin 183 | if fHasValue then Result := fValue 184 | else Exception.Create('no value'); 185 | end; 186 | 187 | procedure TOptional.SetValue(AValue: T); 188 | begin 189 | fValue := AValue; 190 | fHasValue := True; 191 | end; 192 | 193 | procedure TOptional.Clear; 194 | begin 195 | fHasValue := False; 196 | end; 197 | 198 | { TOptionalVariant } 199 | 200 | function TOptionalVariant.GetValue: T; 201 | begin 202 | Result := T(inherited Value); 203 | end; 204 | 205 | procedure TOptionalVariant.SetValue(AValue: T); 206 | begin 207 | inherited Value := AValue; 208 | end; 209 | 210 | constructor TOptionalVariant.Create; 211 | begin 212 | inherited Create; 213 | end; 214 | 215 | constructor TOptionalVariant.Create(AValue: T); 216 | begin 217 | Create; 218 | SetValue(AValue); 219 | end; 220 | 221 | { TOptionalObject } 222 | 223 | function TOptionalObject.GetValue: T; 224 | begin 225 | Result := T(inherited Value); 226 | end; 227 | 228 | procedure TOptionalObject.SetValue(AValue: T); 229 | begin 230 | inherited Value := AValue; 231 | end; 232 | 233 | constructor TOptionalObject.Create; 234 | begin 235 | inherited Create; 236 | end; 237 | 238 | constructor TOptionalObject.Create(AValue: T); 239 | begin 240 | Create; 241 | SetValue(AValue); 242 | end; 243 | 244 | function TOptionalObject.ValueClass: TClass; 245 | begin 246 | Result := T; 247 | end; 248 | 249 | { TGenericCollection } 250 | 251 | function TGenericCollection.GetI(Index : Integer): T; 252 | begin 253 | Result:=T(Inherited Items[Index]); 254 | end; 255 | 256 | procedure TGenericCollection.SetI(Index : Integer; AValue: T); 257 | begin 258 | Inherited Items[Index]:=aValue; 259 | end; 260 | 261 | constructor TGenericCollection.Create; 262 | begin 263 | inherited Create(T); 264 | end; 265 | 266 | function TGenericCollection.Add: T; 267 | begin 268 | Result:=T(Inherited add); 269 | end; 270 | 271 | { TLSPStreamable } 272 | 273 | constructor TLSPStreamable.Create; 274 | begin 275 | Inherited Create; 276 | end; 277 | 278 | { LSPException } 279 | 280 | function EServerNotInitialized.Code: Integer; 281 | begin 282 | result := -32002; 283 | end; 284 | 285 | function EUnknownErrorCode.Code: Integer; 286 | begin 287 | result := -32001; 288 | end; 289 | 290 | function ERequestCancelled.Code: Integer; 291 | begin 292 | result := -32800; 293 | end; 294 | 295 | function EContentModified.Code: Integer; 296 | begin 297 | result := -32801; 298 | end; 299 | 300 | end. 301 | 302 | -------------------------------------------------------------------------------- /src/protocol/LSP.CodeAction.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.CodeAction; 21 | 22 | {$mode objfpc}{$H+} 23 | {$modeswitch advancedrecords} 24 | 25 | interface 26 | 27 | uses 28 | { RTL } 29 | SysUtils, Classes, 30 | { Protocol } 31 | LSP.Base, LSP.Basic, LSP.BaseTypes; 32 | 33 | type 34 | 35 | { TCodeActionKind } 36 | 37 | { The kind of a code action. 38 | Kinds are a hierarchical list of identifiers separated by `.`, e.g. `"refactor.extract.function"`. 39 | The set of kinds is open and client needs to announce the kinds it supports to the server during 40 | initialization. } 41 | 42 | TCodeActionKind = Class 43 | public const 44 | // Empty kind. 45 | Empty = ''; 46 | // Base kind for quickfix actions: 'quickfix'. 47 | QuickFix = 'quickfix'; 48 | // Base kind for refactoring actions: 'refactor'. 49 | Refactor = 'refactor'; 50 | // Base kind for refactoring extraction actions: 'refactor.extract'. 51 | RefactorExtract = 'refactor.extract'; 52 | // Base kind for refactoring inline actions: 'refactor.inline'. 53 | RefactorInline = 'refactor.inline'; 54 | // Base kind for refactoring rewrite actions: 'refactor.rewrite'. 55 | RefactorRewrite = 'refactor.rewrite'; 56 | // Base kind for source actions: `source`. 57 | // Source code actions apply to the entire file. 58 | Source = 'source'; 59 | // Base kind for an organize imports source action: `source.organizeImports`. 60 | SourceOrganizeImports = 'source.organizeImports'; 61 | end; 62 | 63 | { TCodeAction } 64 | 65 | TCodeAction = class(TCollectionItem) 66 | private 67 | fTitle: string; 68 | fKind: String; 69 | fDiagnostics: TDiagnosticItems; 70 | fIsPreferred: boolean; 71 | fEdit: TWorkspaceEdit; 72 | fCommand: TCommand; 73 | procedure SetCommand(AValue: TCommand); 74 | procedure SetDiagnostics(AValue: TDiagnosticItems); 75 | procedure SetEdit(AValue: TWorkspaceEdit); 76 | Public 77 | constructor Create(ACollection: TCollection); override; 78 | destructor Destroy; override; 79 | published 80 | // A short, human-readable, title for this code action. 81 | property title: string read fTitle write fTitle; 82 | // The kind of the code action. 83 | // Used to filter code actions. 84 | property kind: string read fKind write fKind; 85 | // The diagnostics that this code action resolves. 86 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics; 87 | // Marks this as a preferred action. Preferred actions are used by the `auto fix` command and can be targeted 88 | // by keybindings. 89 | // 90 | // A quick fix should be marked preferred if it properly addresses the underlying error. 91 | // A refactoring should be marked preferred if it is the most reasonable choice of actions to take. 92 | // 93 | // @since 3.15.0 94 | property isPreferred: boolean read fIsPreferred write fIsPreferred; 95 | // The workspace edit this code action performs. 96 | property edit: TWorkspaceEdit read fEdit write SetEdit; 97 | // A command this code action executes. If a code action 98 | // provides an edit and a command, first the edit is 99 | // executed and then the command. 100 | property command: TCommand read fCommand write SetCommand; 101 | end; 102 | 103 | TCodeActionItems = specialize TGenericCollection; 104 | 105 | { TCodeActionContext 106 | 107 | Contains additional diagnostic information about the context in which 108 | a code action is run. } 109 | 110 | TCodeActionContext = class(TLSPStreamable) 111 | private 112 | fDiagnostics: TDiagnosticItems; 113 | fOnly: TStrings; 114 | procedure SetDiagnostics(AValue: TDiagnosticItems); 115 | procedure SetOnly(AValue: TStrings); 116 | public 117 | Constructor Create; override; 118 | Destructor Destroy; override; 119 | Procedure Assign(Source : TPersistent); override; 120 | published 121 | // An array of diagnostics known on the client side overlapping the range provided to the 122 | // `textDocument/codeAction` request. They are provided so that the server knows which 123 | // errors are currently presented to the user for the given range. There is no guarantee 124 | // that these accurately reflect the error state of the resource. The primary parameter 125 | // to compute code actions is the provided range. 126 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics; 127 | 128 | // (OPTIONAL) Requested kind of actions to return. 129 | // Actions not of this kind are filtered out by the client before being shown. So servers 130 | // can omit computing them. 131 | property only: TStrings read fOnly write SetOnly; 132 | end; 133 | 134 | { TCodeActionParams } 135 | 136 | TCodeActionParams = class(TLSPStreamable) 137 | private 138 | fTextDocument: TTextDocumentIdentifier; 139 | fRange: TRange; 140 | fContext: TCodeActionContext; 141 | procedure SetContext(AValue: TCodeActionContext); 142 | Public 143 | constructor create; override; 144 | destructor Destroy; override; 145 | Procedure Assign(Source : TPersistent); override; 146 | published 147 | // The document in which the command was invoked. 148 | property textDocument: TTextDocumentIdentifier read fTextDocument write fTextDocument; 149 | // The range for which the command was invoked. 150 | property range: TRange read fRange write fRange; 151 | // Context carrying additional information. 152 | property context: TCodeActionContext read fContext write SetContext; 153 | end; 154 | 155 | 156 | implementation 157 | 158 | { TCodeAction } 159 | 160 | procedure TCodeAction.SetCommand(AValue: TCommand); 161 | begin 162 | if fCommand=AValue then Exit; 163 | fCommand.Assign(AValue); 164 | end; 165 | 166 | procedure TCodeAction.SetDiagnostics(AValue: TDiagnosticItems); 167 | begin 168 | if fDiagnostics=AValue then Exit; 169 | fDiagnostics.Assign(AValue); 170 | end; 171 | 172 | procedure TCodeAction.SetEdit(AValue: TWorkspaceEdit); 173 | begin 174 | if fEdit=AValue then Exit; 175 | fEdit.Assign(AValue); 176 | end; 177 | 178 | constructor TCodeAction.Create(ACollection: TCollection); 179 | begin 180 | inherited Create(ACollection); 181 | fDiagnostics:=TDiagnosticItems.Create; 182 | fEdit:=TWorkspaceEdit.Create; 183 | fCommand:=TCommand.Create; 184 | end; 185 | 186 | destructor TCodeAction.Destroy; 187 | begin 188 | FreeAndNil(fDiagnostics); 189 | FreeAndNil(fEdit); 190 | FreeAndNil(fCommand); 191 | inherited Destroy; 192 | end; 193 | 194 | { TCodeActionContext } 195 | 196 | procedure TCodeActionContext.SetDiagnostics(AValue: TDiagnosticItems); 197 | begin 198 | if fDiagnostics=AValue then Exit; 199 | fDiagnostics.Assign(AValue); 200 | end; 201 | 202 | procedure TCodeActionContext.SetOnly(AValue: TStrings); 203 | begin 204 | if fOnly=AValue then Exit; 205 | fOnly.Assign(AValue); 206 | end; 207 | 208 | constructor TCodeActionContext.Create; 209 | begin 210 | inherited Create; 211 | fDiagnostics:=TDiagnosticItems.Create; 212 | fOnly:=TStringList.Create; 213 | end; 214 | 215 | destructor TCodeActionContext.Destroy; 216 | begin 217 | FreeAndNil(fDiagnostics); 218 | FreeAndNil(fOnly); 219 | inherited Destroy; 220 | end; 221 | 222 | procedure TCodeActionContext.Assign(Source: TPersistent); 223 | var 224 | src: TCodeActionContext absolute source; 225 | begin 226 | if Source is TCodeActionContext then 227 | begin 228 | Diagnostics.Assign(Src.diagnostics); 229 | Only.Assign(Src.Only); 230 | end 231 | else 232 | inherited Assign(Source); 233 | end; 234 | 235 | { TCodeActionParams } 236 | 237 | procedure TCodeActionParams.SetContext(AValue: TCodeActionContext); 238 | begin 239 | if fContext=AValue then Exit; 240 | fContext:=AValue; 241 | end; 242 | 243 | constructor TCodeActionParams.create; 244 | begin 245 | inherited create; 246 | fTextDocument:=TTextDocumentIdentifier.Create; 247 | fRange:=TRange.Create; 248 | fContext:=TCodeActionContext.Create; 249 | end; 250 | 251 | destructor TCodeActionParams.Destroy; 252 | begin 253 | FreeAndNil(fTextDocument); 254 | FreeAndNil(fRange); 255 | FreeAndNil(fContext); 256 | inherited Destroy; 257 | end; 258 | 259 | procedure TCodeActionParams.Assign(Source: TPersistent); 260 | var 261 | Src: TCodeActionParams absolute Source; 262 | begin 263 | if Source is TCodeActionParams then 264 | begin 265 | TextDocument.Assign(Src.textDocument); 266 | Range.Assign(Src.Range); 267 | Context.Assign(Src.context); 268 | end 269 | else 270 | inherited Assign(Source); 271 | end; 272 | 273 | end. 274 | 275 | -------------------------------------------------------------------------------- /src/protocol/LSP.Diagnostics.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.Diagnostics; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, 29 | { Protocol } 30 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages; 31 | 32 | type 33 | 34 | { TPublishDiagnosticsParams } 35 | 36 | TPublishDiagnosticsParams = class(TLSPStreamable) 37 | private 38 | fUri: TDocumentUri; 39 | fDiagnostics: TDiagnosticItems; 40 | procedure SetDiagnostics(AValue: TDiagnosticItems); 41 | published 42 | // The URI for which diagnostic information is reported. 43 | property uri: TDocumentUri read fUri write fUri; 44 | 45 | // The version number of the document the diagnostics are published for. 46 | // todo: this must be optional 47 | //property version: integer read fVersion write fVersion; 48 | 49 | // An array of diagnostic information items. 50 | property diagnostics: TDiagnosticItems read fDiagnostics write SetDiagnostics; 51 | public 52 | Constructor Create; override; 53 | Destructor Destroy; override; 54 | end; 55 | 56 | { TPublishDiagnostics } 57 | 58 | { Diagnostics notification are sent from the server to the client to signal results of validation runs. 59 | 60 | Diagnostics are “owned” by the server so it is the server’s responsibility to clear them if necessary. 61 | The following rule is used for VS Code servers that generate diagnostics: 62 | 63 | if a language is single file only (for example HTML) then diagnostics are cleared by the server when the file is closed. 64 | if a language has a project system (for example C#) diagnostics are not cleared when a file closes. When a project is 65 | opened all diagnostics for all files are recomputed (or read from a cache). 66 | When a file changes it is the server’s responsibility to re-compute diagnostics and push them to the client. If the 67 | computed set is empty it has to push the empty array to clear former diagnostics. Newly pushed diagnostics always replace 68 | previously pushed diagnostics. There is no merging that happens on the client side. } 69 | 70 | TPublishDiagnostics = class(TNotificationMessage) 71 | private 72 | function GetDiagnosticParams: TPublishDiagnosticsParams; 73 | public 74 | constructor Create; override; 75 | destructor Destroy; override; 76 | function HaveDiagnostics : Boolean; 77 | Property DiagnosticParams : TPublishDiagnosticsParams Read GetDiagnosticParams; 78 | procedure Add(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity); 79 | procedure Clear(fileName: string); 80 | end; 81 | 82 | 83 | implementation 84 | 85 | uses SysUtils; 86 | 87 | { TPublishDiagnostics } 88 | 89 | procedure TPublishDiagnostics.Clear(fileName: string); 90 | begin 91 | DiagnosticParams.uri := PathToURI(fileName); 92 | DiagnosticParams.diagnostics.Clear; 93 | end; 94 | 95 | procedure TPublishDiagnostics.Add(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity); 96 | var 97 | Diagnostic: TDiagnostic; 98 | begin 99 | DiagnosticParams.uri := PathToURI(fileName); 100 | Diagnostic := DiagnosticParams.diagnostics.Add; 101 | Diagnostic.range.SetRange(line, column); 102 | Diagnostic.severity := severity; 103 | Diagnostic.code := code; 104 | Diagnostic.source := 'Free Pascal Compiler'; 105 | Diagnostic.message := message; 106 | end; 107 | 108 | function TPublishDiagnostics.GetDiagnosticParams: TPublishDiagnosticsParams; 109 | 110 | begin 111 | Result:=Params as TPublishDiagnosticsParams; 112 | end; 113 | 114 | constructor TPublishDiagnostics.Create; 115 | begin 116 | params := TPublishDiagnosticsParams.Create; 117 | method := 'textDocument/publishDiagnostics'; 118 | end; 119 | 120 | destructor TPublishDiagnostics.Destroy; 121 | begin 122 | params.Free; 123 | inherited; 124 | end; 125 | 126 | function TPublishDiagnostics.HaveDiagnostics: Boolean; 127 | begin 128 | Result:=DiagnosticParams.diagnostics.Count>0; 129 | end; 130 | 131 | { TPublishDiagnosticsParams } 132 | 133 | procedure TPublishDiagnosticsParams.SetDiagnostics(AValue: TDiagnosticItems); 134 | begin 135 | if fDiagnostics=AValue then Exit; 136 | fDiagnostics.Assign(AValue); 137 | end; 138 | 139 | constructor TPublishDiagnosticsParams.Create; 140 | begin 141 | inherited; 142 | fdiagnostics := TDiagnosticItems.Create; 143 | end; 144 | 145 | destructor TPublishDiagnosticsParams.Destroy; 146 | begin 147 | FreeAndNil(fDiagnostics); 148 | inherited Destroy; 149 | end; 150 | 151 | 152 | end. 153 | -------------------------------------------------------------------------------- /src/protocol/LSP.DocumentHighlight.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.DocumentHighlight; 21 | 22 | {$mode objfpc}{$H+} 23 | {$scopedenums on} 24 | 25 | interface 26 | uses 27 | { RTL } 28 | SysUtils, Classes, 29 | { Protocol } 30 | LSP.Base, LSP.Basic, 31 | { Other } 32 | LSP.BaseTypes; 33 | 34 | type 35 | TDocumentHighlightKind = ( 36 | __UNUSED__, 37 | Text, // A textual occurrence. 38 | Read, // Read-access of a symbol, like reading a variable. 39 | Write // Write-access of a symbol, like writing to a variable. 40 | ); 41 | 42 | { TDocumentHighlight } 43 | 44 | TDocumentHighlight = class(TCollectionItem) 45 | private 46 | fRange: TRange; 47 | fKind: TDocumentHighlightKind; 48 | procedure SetRange(AValue: TRange); 49 | published 50 | // The range this highlight applies to. 51 | property range: TRange read fRange write SetRange; 52 | 53 | // The highlight kind, default is DocumentHighlightKind.Text. 54 | property kind: TDocumentHighlightKind read fKind write fKind; 55 | public 56 | constructor Create(aCollection : TCollection); override; 57 | // _range will be owned. 58 | constructor Create(aCollection : TCollection; _kind: TDocumentHighlightKind; _range: TRange); 59 | Destructor Destroy; override; 60 | end; 61 | 62 | TDocumentHighlightItems = Specialize TGenericCollection; 63 | 64 | { DocumentHighlightParams } 65 | 66 | TDocumentHighlightParams = class(TTextDocumentPositionParams) 67 | end; 68 | 69 | 70 | implementation 71 | 72 | procedure TDocumentHighlight.SetRange(AValue: TRange); 73 | begin 74 | if fRange=AValue then Exit; 75 | fRange.Assign(AValue); 76 | end; 77 | 78 | constructor TDocumentHighlight.Create(aCollection: TCollection); 79 | begin 80 | Create(aCollection,TDocumentHighlightKind.__UNUSED__,TRange.Create); 81 | end; 82 | 83 | constructor TDocumentHighlight.Create(aCollection : TCollection; _kind: TDocumentHighlightKind; _range: TRange); 84 | begin 85 | Inherited Create(aCollection); 86 | kind := _kind; 87 | FRange := _range; 88 | end; 89 | 90 | destructor TDocumentHighlight.Destroy; 91 | begin 92 | FreeAndNil(Frange); 93 | inherited Destroy; 94 | end; 95 | 96 | end. 97 | -------------------------------------------------------------------------------- /src/protocol/LSP.ExecuteCommand.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.ExecuteCommand; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | uses 26 | { RTL } 27 | SysUtils, Classes, FPJSON, 28 | { Protocol } 29 | LSP.Base, LSP.WorkDoneProgress; 30 | 31 | type 32 | { TExecuteCommandParams 33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#executeCommandParams 34 | 35 | The arguments are typically specified when a command is returned from the server to the client. 36 | Example requests that return a command are `textDocument/codeAction` or `textDocument/codeLens`. } 37 | 38 | TExecuteCommandParams = class(TWorkDoneProgressParams) 39 | private 40 | fCommand: String; 41 | fArguments: TJSONArray; 42 | published 43 | // The identifier of the actual command handler. 44 | property command: String read fCommand write fCommand; 45 | // Arguments that the command should be invoked with. 46 | property arguments: TJSONArray read fArguments write fArguments; 47 | public 48 | destructor Destroy; override; 49 | end; 50 | 51 | 52 | implementation 53 | 54 | 55 | destructor TExecuteCommandParams.Destroy; 56 | begin 57 | FreeAndNil(fArguments); 58 | inherited; 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /src/protocol/LSP.Hover.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.Hover; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, 29 | { Protocol } 30 | LSP.BaseTypes,LSP.Base, LSP.Basic; 31 | 32 | type 33 | 34 | { THoverResponse } 35 | 36 | THoverResponse = class(TLSPStreamable) 37 | private 38 | fContents: TMarkupContent; 39 | fRange: TRange; 40 | procedure SetContents(AValue: TMarkupContent); 41 | procedure SetRange(AValue: TRange); 42 | Public 43 | Constructor Create; override; 44 | Destructor Destroy; override; 45 | published 46 | // The hover's content 47 | property contents: TMarkupContent read fContents write SetContents; 48 | 49 | // An optional range is a range inside a text document 50 | // that is used to visualize a hover, e.g. by changing the background color. 51 | property range: TRange read fRange write SetRange; 52 | end; 53 | 54 | 55 | implementation 56 | 57 | uses 58 | SysUtils; 59 | 60 | { THoverResponse } 61 | 62 | procedure THoverResponse.SetContents(AValue: TMarkupContent); 63 | begin 64 | if fContents=AValue then Exit; 65 | fContents.Assign(AValue); 66 | end; 67 | 68 | procedure THoverResponse.SetRange(AValue: TRange); 69 | begin 70 | if fRange=AValue then Exit; 71 | fRange.Assign(AValue); 72 | end; 73 | 74 | constructor THoverResponse.Create; 75 | begin 76 | inherited Create; 77 | fContents:=TMarkupContent.Create; 78 | fRange:=TRange.Create; 79 | end; 80 | 81 | destructor THoverResponse.Destroy; 82 | begin 83 | FreeAndNil(fContents); 84 | FreeAndNil(fRange); 85 | inherited Destroy; 86 | end; 87 | 88 | { THoverRequest } 89 | end. 90 | 91 | -------------------------------------------------------------------------------- /src/protocol/LSP.InlayHint.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.InlayHint; 21 | 22 | {$mode objfpc}{$H+} 23 | {$scopedenums on} 24 | 25 | interface 26 | 27 | uses 28 | { RTL } 29 | Classes, SysUtils, 30 | { LSP Protocol } 31 | LSP.Base, LSP.Basic, LSP.BaseTypes; 32 | 33 | type 34 | 35 | { TInlayHintKind } 36 | TInlayHintKind = ( 37 | // TODO: do we need this for optionals? 38 | __UNUSED__, 39 | _Type, // An inlay hint that for a type annotation. 40 | Parameter // An inlay hint that is for a parameter. 41 | ); 42 | 43 | TOptionalInlayHintKind = specialize TOptional; 44 | 45 | { TInlayHint 46 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#inlayHint 47 | 48 | Inlay hint information. } 49 | 50 | TInlayHint = class(TCollectionItem) 51 | private 52 | fPosition: TPosition; 53 | fLabel: String; // string | InlayHintLabelPart[] (not supported now) 54 | fKind: TOptionalInlayHintKind; 55 | fTextEdits: TTextEdits; 56 | fTooltip: String; 57 | public 58 | Constructor Create(ACollection: TCollection); override; 59 | published 60 | // The position of this hint. 61 | property position: TPosition read fPosition write fPosition; 62 | // The label of this hint. A human readable string or an array of 63 | // InlayHintLabelPart label parts. 64 | // 65 | // *Note* that neither the string nor the label part can be empty. 66 | property &label: String read fLabel write fLabel; 67 | // The kind of this hint. Can be omitted in which case the client 68 | // should fall back to a reasonable default. 69 | // owned by the inlayhint 70 | property kind: TOptionalInlayHintKind read fKind write fKind; 71 | // Optional text edits that are performed when accepting this inlay hint. 72 | // 73 | // *Note* that edits are expected to change the document so that the inlay 74 | // hint (or its nearest variant) is now part of the document and the inlay 75 | // hint itself is now obsolete. 76 | // 77 | // Depending on the client capability `inlayHint.resolveSupport` clients 78 | // might resolve this property late using the resolve request. 79 | property textEdits: TTextEdits read fTextEdits write fTextEdits; 80 | // The tooltip text when you hover over this item. 81 | // 82 | // Depending on the client capability `inlayHint.resolveSupport` clients 83 | // might resolve this property late using the resolve request. 84 | property tooltip: String read fTooltip write fTooltip; 85 | public 86 | destructor Destroy; override; 87 | end; 88 | 89 | TInlayHints = specialize TGenericCollection; 90 | 91 | { TInlayHintParams 92 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#inlayHintParams 93 | 94 | A parameter literal used in inlay hint requests. } 95 | 96 | TInlayHintParams = class(TLSPStreamable) 97 | private 98 | fTextDocument: TTextDocumentIdentifier; 99 | fRange: TRange; 100 | procedure SetRange(AValue: TRange); 101 | procedure SetTextDocument(AValue: TTextDocumentIdentifier); 102 | published 103 | // The text document. 104 | property textDocument: TTextDocumentIdentifier read fTextDocument write SetTextDocument; 105 | // The visible document range for which inlay hints should be computed. 106 | property range: TRange read fRange write SetRange; 107 | public 108 | constructor create; override; 109 | destructor Destroy; override; 110 | end; 111 | 112 | implementation 113 | 114 | { TInlayHint } 115 | 116 | constructor TInlayHint.Create(ACollection: TCollection); 117 | begin 118 | inherited Create(ACollection); 119 | fPosition:=TPosition.Create; 120 | fTextEdits:=TTextEdits.Create; 121 | end; 122 | 123 | destructor TInlayHint.Destroy; 124 | begin 125 | FreeAndNil(fPosition); 126 | FreeAndNil(fKind); 127 | FreeAndNil(fTextEdits); 128 | inherited; 129 | end; 130 | 131 | { TInlayHintParams } 132 | 133 | procedure TInlayHintParams.SetRange(AValue: TRange); 134 | begin 135 | if fRange=AValue then Exit; 136 | fRange.Assign(AValue); 137 | end; 138 | 139 | procedure TInlayHintParams.SetTextDocument(AValue: TTextDocumentIdentifier); 140 | begin 141 | if fTextDocument=AValue then Exit; 142 | fTextDocument.Assign(AValue); 143 | end; 144 | 145 | constructor TInlayHintParams.create; 146 | begin 147 | inherited create; 148 | ftextDocument:=TTextDocumentIdentifier.Create; 149 | frange:=TRange.Create; 150 | end; 151 | 152 | destructor TInlayHintParams.Destroy; 153 | begin 154 | FreeAndNil(fTextDocument); 155 | FreeAndNil(fRange); 156 | inherited; 157 | end; 158 | 159 | end. 160 | -------------------------------------------------------------------------------- /src/protocol/LSP.Messages.pas: -------------------------------------------------------------------------------- 1 | // Copyright 2023 Michael Van Canneyt 2 | // This file is part of Pascal Language Server. 3 | 4 | // Pascal Language Server is free software: you can redistribute it 5 | // and/or modify it under the terms of the GNU General Public License 6 | // as published by the Free Software Foundation, either version 3 of 7 | // the License, or (at your option) any later version. 8 | 9 | // Pascal Language Server is distributed in the hope that it will be 10 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 11 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | // GNU General Public License for more details. 13 | 14 | // You should have received a copy of the GNU General Public License 15 | // along with Pascal Language Server. If not, see 16 | // . 17 | 18 | unit LSP.Messages; 19 | 20 | {$mode objfpc}{$H+} 21 | 22 | interface 23 | 24 | uses 25 | Classes, SysUtils, LSP.Streaming, fpJSON, LSP.BaseTypes; 26 | 27 | Type 28 | // We cannot assume stdout to send out-of-band messages. 29 | 30 | { TMessageTransport } 31 | TMessageLog = procedure(sender : TObject; Const Msg : UTF8String) of object; 32 | 33 | TMessageTransport = class 34 | Protected 35 | Procedure DoSendMessage(aMessage : TJSONData); virtual; abstract; 36 | Procedure DoSendDiagnostic(const aMessage : UTF8String); virtual; abstract; 37 | Procedure DoLog(Const Msg : UTF8String); overload; 38 | Procedure DoLog(Const Fmt : UTF8String; Const args : array of const); overload; 39 | Public 40 | Class Var OnLog : TMessageLog; 41 | Public 42 | Procedure SendMessage(aMessage : TJSONData); 43 | Procedure SendDiagnostic(const aMessage : UTF8String); 44 | Procedure SendDiagnostic(const Fmt : String; const args : Array of const); overload; 45 | end; 46 | 47 | { TAbstractMessage 48 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#abstractMessage 49 | 50 | A general message as defined by JSON-RPC. The language server 51 | protocol always uses “2.0” as the jsonrpc version. } 52 | 53 | TAbstractMessage = class(TLSPStreamable) 54 | private 55 | function GetJSONRPC: String; 56 | published 57 | property jsonrpc: String read GetJSONRPC; 58 | public 59 | procedure Send(aTransport : TMessageTransport); 60 | end; 61 | 62 | { TRequestMessage 63 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#requestMessage 64 | 65 | A request message to describe a request between the client and the server. 66 | Every processed request must send a response back to the sender of the request. } 67 | 68 | TRequestMessage = class(TAbstractMessage) 69 | protected 70 | fID: TOptionalAny; // integer | string 71 | fMethod: string; 72 | fParams: TLSPStreamable; 73 | published 74 | // The request id. 75 | property id: TOptionalAny read fID write fID; 76 | // The method to be invoked. 77 | property method: string read fMethod write fMethod; 78 | // The notification's params. Not freed when message is freed. 79 | property params: TLSPStreamable read fParams write fParams; 80 | end; 81 | 82 | { TNotificationMessage 83 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#notificationMessage 84 | 85 | A notification message. A processed notification message 86 | must not send a response back. They work like events. } 87 | 88 | TNotificationMessage = class(TAbstractMessage) 89 | protected 90 | fMethod: string; 91 | fParams: TLSPStreamable; 92 | published 93 | // The method to be invoked. 94 | property method: string read fMethod write fMethod; 95 | // The notification's params. 96 | property params: TLSPStreamable read fParams write fParams; 97 | end; 98 | 99 | 100 | 101 | const 102 | ContentType = 'application/vscode-jsonrpc; charset=utf-8'; 103 | 104 | 105 | implementation 106 | 107 | { TMessageTransport } 108 | 109 | procedure TMessageTransport.DoLog(const Msg: UTF8String); 110 | begin 111 | If Assigned(OnLog) then 112 | OnLog(Self,Msg); 113 | end; 114 | 115 | procedure TMessageTransport.DoLog(const Fmt: UTF8String; 116 | const args: array of const); 117 | begin 118 | DoLog(Format(Fmt,Args)); 119 | end; 120 | 121 | procedure TMessageTransport.SendMessage(aMessage: TJSONData); 122 | begin 123 | DoLog('Sending message: %s',[aMessage.AsJSON]); 124 | DoSendMessage(aMessage); 125 | end; 126 | 127 | procedure TMessageTransport.SendDiagnostic(const aMessage: UTF8String); 128 | begin 129 | DoLog('Sending diagnostic: %s',[aMessage]); 130 | DoSendDiagnostic(aMessage); 131 | end; 132 | 133 | procedure TMessageTransport.SendDiagnostic(const Fmt: String; 134 | const args: array of const); 135 | begin 136 | SendDiagnostic(Format(Fmt,Args)); 137 | end; 138 | 139 | { TAbstractMessage } 140 | 141 | function TAbstractMessage.GetJSONRPC: String; 142 | begin 143 | result := '2.0'; 144 | end; 145 | 146 | procedure TAbstractMessage.Send(aTransport : TMessageTransport); 147 | var 148 | Data: TJSONData; 149 | 150 | begin 151 | Data := specialize 152 | TLSPStreaming.ToJSON(self); 153 | if Data <> nil then 154 | begin 155 | aTransport.SendMessage(Data); 156 | Data.Free; 157 | end; 158 | end; 159 | 160 | 161 | end. 162 | 163 | -------------------------------------------------------------------------------- /src/protocol/LSP.References.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.References; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | SysUtils, Classes, 29 | { Protocol } 30 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages; 31 | 32 | type 33 | 34 | { TReferenceContext } 35 | 36 | TReferenceContext = class(TLSPStreamable) 37 | private 38 | fIncludeDeclaration: boolean; 39 | published 40 | // Include the declaration of the current symbol. 41 | property includeDeclaration: boolean read fIncludeDeclaration write fIncludeDeclaration; 42 | end; 43 | 44 | { TReferenceParams } 45 | 46 | TReferenceParams = class(TTextDocumentPositionParams) 47 | private 48 | fContext: TReferenceContext; 49 | procedure SetContext(AValue: TReferenceContext); 50 | public 51 | Constructor Create; override; 52 | Destructor Destroy; override; 53 | Procedure Assign(Source: TPersistent); override; 54 | published 55 | property context: TReferenceContext read fContext write SetContext; 56 | end; 57 | 58 | 59 | 60 | implementation 61 | 62 | 63 | { TReferenceParams } 64 | 65 | procedure TReferenceParams.SetContext(AValue: TReferenceContext); 66 | begin 67 | if fContext=AValue then Exit; 68 | fContext.Assign(AValue); 69 | end; 70 | 71 | constructor TReferenceParams.Create; 72 | begin 73 | inherited Create; 74 | fContext:=TReferenceContext.Create; 75 | end; 76 | 77 | destructor TReferenceParams.Destroy; 78 | begin 79 | FreeAndNil(fContext); 80 | inherited Destroy; 81 | end; 82 | 83 | procedure TReferenceParams.Assign(Source: TPersistent); 84 | var 85 | Src: TReferenceParams absolute Source; 86 | begin 87 | if Source is TReferenceParams then 88 | begin 89 | Context.Assign(Src.context); 90 | end 91 | else 92 | inherited Assign(Source); 93 | end; 94 | 95 | end. 96 | 97 | -------------------------------------------------------------------------------- /src/protocol/LSP.SignatureHelp.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.SignatureHelp; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, 29 | { Protocol } 30 | LSP.Base, LSP.Basic, LSP.BaseTypes; 31 | 32 | type 33 | 34 | { TParameterInformation } 35 | 36 | { Represents a parameter of a callable-signature. A parameter can 37 | have a label and a doc-comment. } 38 | 39 | TParameterInformation = class(TCollectionItem) 40 | private 41 | fLabel: string; 42 | fDocumentation: TMarkupContent; 43 | procedure SetDocumentation(AValue: TMarkupContent); 44 | Public 45 | Constructor Create(ACollection: TCollection); override; 46 | Destructor Destroy; override; 47 | Procedure Assign(Source: TPersistent); override; 48 | published 49 | // The label of this parameter information. 50 | // 51 | // Either a string or an inclusive start and exclusive end offsets within its containing 52 | // signature label. (see SignatureInformation.label). The offsets are based on a UTF-16 53 | // string representation as `Position` and `Range` does. 54 | // 55 | // *Note*: a label of type string should be a substring of its containing signature label. 56 | // Its intended use case is to highlight the parameter label part in the `SignatureInformation.label`. 57 | property &label: string read fLabel write fLabel; 58 | 59 | // The human-readable doc-comment of this parameter. Will be shown 60 | // in the UI but can be omitted. 61 | property documentation: TMarkupContent read fDocumentation write SetDocumentation; 62 | end; 63 | 64 | TParameterInformationCollection = specialize TGenericCollection; 65 | 66 | { TSignatureInformation } 67 | 68 | { Represents the signature of something callable. A signature 69 | can have a label, like a function-name, a doc-comment, and 70 | a set of parameters. } 71 | 72 | TSignatureInformation = class(TCollectionItem) 73 | private 74 | fLabel: string; 75 | fDocumentation: TMarkupContent; 76 | fParameters: TParameterInformationCollection; 77 | procedure SetDocumentation(AValue: TMarkupContent); 78 | procedure SetParameters(AValue: TParameterInformationCollection); 79 | Public 80 | Constructor Create(ACollection: TCollection); override; 81 | destructor Destroy; override; 82 | published 83 | // The label of this signature. Will be shown in 84 | // the UI. 85 | property &label: string read fLabel write fLabel; 86 | 87 | // The human-readable doc-comment of this signature. Will be shown 88 | // in the UI but can be omitted. 89 | property documentation: TMarkupContent read fDocumentation write SetDocumentation; 90 | 91 | // The parameters of this signature. 92 | property parameters: TParameterInformationCollection read fParameters write SetParameters; 93 | end; 94 | 95 | TSignatureInformationCollection = specialize TGenericCollection; 96 | 97 | { TSignatureHelp 98 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#signatureHelp 99 | 100 | Signature help represents the signature of something callable. 101 | There can be multiple signature but only one active and only one active parameter. } 102 | 103 | TSignatureHelp = class(TLSPStreamable) 104 | private 105 | fSignatures: TSignatureInformationCollection; 106 | fActiveSignature: integer; 107 | fActiveParameter: integer; 108 | procedure SetSignatures(AValue: TSignatureInformationCollection); 109 | Public 110 | Constructor Create; override; 111 | Destructor Destroy; override; 112 | published 113 | // One or more signatures. 114 | property signatures: TSignatureInformationCollection read fSignatures write SetSignatures; 115 | 116 | // The active signature. If omitted or the value lies outside the 117 | // range of `signatures` the value defaults to zero or is ignored if 118 | // `signatures.length === 0`. Whenever possible implementors should 119 | // make an active decision about the active signature and shouldn't 120 | // rely on a default value. 121 | // In future version of the protocol this property might become 122 | // mandatory to better express this. 123 | property activeSignature: integer read fActiveSignature write fActiveSignature; 124 | 125 | // The active parameter of the active signature. If omitted or the value 126 | // lies outside the range of `signatures[activeSignature].parameters` 127 | // defaults to 0 if the active signature has parameters. If 128 | // the active signature has no parameters it is ignored. 129 | // In future version of the protocol this property might become 130 | // mandatory to better express the active parameter if the 131 | // active signature does have any. 132 | property activeParameter: integer read fActiveParameter write fActiveParameter; 133 | 134 | end; 135 | 136 | 137 | implementation 138 | 139 | uses 140 | { RTL } 141 | SysUtils; 142 | 143 | { TParameterInformation } 144 | 145 | procedure TParameterInformation.SetDocumentation(AValue: TMarkupContent); 146 | begin 147 | if fDocumentation=AValue then Exit; 148 | fDocumentation.Assign(AValue); 149 | end; 150 | 151 | constructor TParameterInformation.Create(ACollection: TCollection); 152 | begin 153 | inherited Create(ACollection); 154 | fDocumentation:=TMarkupContent.Create; 155 | end; 156 | 157 | destructor TParameterInformation.Destroy; 158 | begin 159 | FreeAndNil(fDocumentation); 160 | Inherited; 161 | end; 162 | 163 | procedure TParameterInformation.Assign(Source: TPersistent); 164 | var 165 | Src: TParameterInformation absolute Source; 166 | begin 167 | if Source is TParameterInformation then 168 | begin 169 | fLabel:=Src.fLabel; 170 | Documentation.Assign(Src.documentation); 171 | end 172 | else 173 | inherited Assign(Source); 174 | end; 175 | 176 | { TSignatureInformation } 177 | 178 | procedure TSignatureInformation.SetDocumentation(AValue: TMarkupContent); 179 | begin 180 | if fDocumentation=AValue then Exit; 181 | fDocumentation.Assign(AValue); 182 | end; 183 | 184 | procedure TSignatureInformation.SetParameters( 185 | AValue: TParameterInformationCollection); 186 | begin 187 | if fParameters=AValue then Exit; 188 | fParameters.Assign(AValue); 189 | end; 190 | 191 | constructor TSignatureInformation.Create(ACollection: TCollection); 192 | begin 193 | inherited Create(ACollection); 194 | fDocumentation:=TMarkupContent.Create; 195 | fParameters:=TParameterInformationCollection.Create; 196 | end; 197 | 198 | destructor TSignatureInformation.Destroy; 199 | begin 200 | FreeAndNil(fDocumentation); 201 | FreeAndNil(fParameters); 202 | inherited Destroy; 203 | end; 204 | 205 | { TSignatureHelp } 206 | 207 | procedure TSignatureHelp.SetSignatures(AValue: TSignatureInformationCollection); 208 | begin 209 | if fSignatures=AValue then Exit; 210 | fSignatures.Assign(AValue); 211 | end; 212 | 213 | constructor TSignatureHelp.Create; 214 | begin 215 | inherited Create; 216 | fSignatures:=TSignatureInformationCollection.Create; 217 | end; 218 | 219 | destructor TSignatureHelp.Destroy; 220 | begin 221 | FreeAndNil(fSignatures); 222 | inherited Destroy; 223 | end; 224 | 225 | end. 226 | 227 | -------------------------------------------------------------------------------- /src/protocol/LSP.Window.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.Window; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | SysUtils, Classes, 29 | { Protocol } 30 | LSP.Base, LSP.BaseTypes, LSP.Messages; 31 | 32 | type 33 | 34 | { TMessageType } 35 | 36 | TMessageType = ( 37 | __UNUSED__, 38 | Error, // An error message. 39 | Warning, // A warning message. 40 | Info, // An information message. 41 | Log // A log message. 42 | ); 43 | 44 | { TShowMessageParams } 45 | 46 | TShowMessageParams = class(TLSPStreamable) 47 | private 48 | fType: TMessageType; 49 | fMessage: string; 50 | Public 51 | Procedure Assign(Source: TPersistent); override; 52 | published 53 | // The message type. 54 | property &type: TMessageType read fType write fType; 55 | // The actual message. 56 | property message: string read fMessage write fMessage; 57 | end; 58 | 59 | { TShowMessageNotification 60 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#window_showMessage 61 | 62 | The show message notification is sent from a server to a client to ask 63 | the client to display a particular message in the user interface. } 64 | 65 | TShowMessageNotification = class(TNotificationMessage) 66 | public 67 | constructor Create; override; 68 | constructor Create(_type: TMessageType; Message: String); 69 | destructor Destroy; override; 70 | end; 71 | 72 | TMessageActionItem = class(TCollectionItem) 73 | private 74 | fTitle: string; 75 | published 76 | // A short title like 'Retry', 'Open Log' etc. 77 | property title: string read fTitle write fTitle; 78 | end; 79 | 80 | TMessageActionItems = specialize TGenericCollection; 81 | 82 | { TShowMessageRequestParams } 83 | 84 | TShowMessageRequestParams = class(TShowMessageParams) 85 | private 86 | fActions: TMessageActionItems; 87 | procedure SetActions(AValue: TMessageActionItems); 88 | public 89 | Constructor Create; override; 90 | Destructor Destroy; override; 91 | // The message action items to present. 92 | property actions: TMessageActionItems read fActions write SetActions; 93 | end; 94 | 95 | implementation 96 | 97 | { TShowMessageParams } 98 | 99 | procedure TShowMessageParams.Assign(Source: TPersistent); 100 | Var 101 | Src: TShowMessageParams absolute Source; 102 | begin 103 | if Source is TShowMessageParams then 104 | begin 105 | fType:= Src.fType; 106 | fMessage:= Src.fMessage; 107 | end 108 | else 109 | inherited Assign(Source); 110 | end; 111 | 112 | { TShowMessageNotification } 113 | 114 | constructor TShowMessageNotification.Create; 115 | begin 116 | inherited Create; 117 | params := TShowMessageParams.Create; 118 | end; 119 | 120 | constructor TShowMessageNotification.Create(_type: TMessageType; Message: String); 121 | begin 122 | Create; 123 | TShowMessageParams(params).&type := _type; 124 | TShowMessageParams(params).message := Message; 125 | method := 'window/showMessage'; 126 | end; 127 | 128 | destructor TShowMessageNotification.Destroy; 129 | begin 130 | params.Free; 131 | inherited; 132 | end; 133 | 134 | { TShowMessageRequstParams } 135 | 136 | procedure TShowMessageRequestParams.SetActions(AValue: TMessageActionItems); 137 | begin 138 | if fActions=AValue then Exit; 139 | fActions.Assign(AValue); 140 | end; 141 | 142 | constructor TShowMessageRequestParams.Create; 143 | begin 144 | inherited Create; 145 | fActions:=TMessageActionItems.Create; 146 | end; 147 | 148 | destructor TShowMessageRequestParams.Destroy; 149 | begin 150 | FreeAndNil(fActions); 151 | inherited Destroy; 152 | end; 153 | 154 | end. 155 | -------------------------------------------------------------------------------- /src/protocol/LSP.WorkDoneProgress.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit LSP.WorkDoneProgress; 21 | 22 | {$mode objfpc}{$H+} 23 | {$scopedenums on} 24 | 25 | interface 26 | uses 27 | { RTL } 28 | Classes, LSP.BaseTypes; 29 | 30 | type 31 | TProgressToken = String; { integer | string } 32 | 33 | type 34 | TWorkDoneProgressParams = class(TLSPStreamable) 35 | private 36 | fWorkDoneToken: TProgressToken; 37 | published 38 | // An optional token that a server can use to report work done progress. 39 | property workDoneToken: TProgressToken read fWorkDoneToken write fWorkDoneToken; 40 | end; 41 | 42 | implementation 43 | 44 | end. 45 | -------------------------------------------------------------------------------- /src/protocol/PasLS.TextLoop.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // LSP Text/File based protocol - in particular, Standard Input/Output/Error files. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit PasLS.TextLoop; 21 | 22 | {$mode ObjFPC}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | Classes, SysUtils, LSP.Base, LSP.Messages, fpjson; 28 | 29 | Type 30 | 31 | { TTextLSPContext } 32 | PText = ^Text; 33 | 34 | { TLSPTextTransport } 35 | 36 | TLSPTextTransport = class(TMessageTransport) 37 | FOutput : PText; 38 | FError : PText; 39 | Protected 40 | Procedure DoSendMessage(aMessage: TJSONData); override; 41 | Procedure DoSendDiagnostic(const aMessage: UTF8String); override; 42 | Public 43 | constructor Create(aOutput,aError : PText); reintroduce; 44 | Procedure EmitMessage(aMessage: TJSONStringType); 45 | end; 46 | 47 | 48 | 49 | Procedure SetupTextLoop(var aInput,aOutput,aError : Text); 50 | Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext); 51 | procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String); 52 | 53 | implementation 54 | 55 | Procedure SetupTextLoop(var aInput,aOutput,aError : Text); 56 | 57 | begin 58 | TJSONData.CompressedJSON := True; 59 | SetTextLineEnding(aInput, #13#10); 60 | SetTextLineEnding(aOutput, #13#10); 61 | SetTextLineEnding(aError, #13#10); 62 | end; 63 | 64 | 65 | procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String); 66 | 67 | var 68 | Content: TJSONStringType; 69 | Request: TJSONData; 70 | Response: TJSONData; 71 | 72 | begin 73 | Response:=Nil; 74 | Writeln(aFile,'▶️ ', aMethod); 75 | Content := '{"jsonrpc": "2.0","id": '+aContext.NextMessageID.ToString+', "method": "'+aMethod+'","params": '+aParams+'}'; 76 | Request := GetJSON(Content, True); 77 | try 78 | Response := aContext.Execute(Request); 79 | if Assigned(Response) then 80 | begin 81 | writeln(aFile,'◀️ response: '); 82 | writeln(aFile,Response.FormatJSON); 83 | Flush(aFile); 84 | end; 85 | finally 86 | Request.Free; 87 | Response.Free; 88 | end; 89 | end; 90 | 91 | 92 | 93 | Function ReadRequest(var aFile : text; aContext : TLSPContext) : TJSONData; 94 | 95 | Var 96 | Header,Name,Value: String; 97 | Content : TJSONStringType; 98 | I,ContentLength : Integer; 99 | P : PJSONCharType; 100 | 101 | begin 102 | Result:=Nil; 103 | aContext.Log('Reading request'); 104 | ReadLn(aFile,Header); 105 | while Header <> '' do 106 | begin 107 | aContext.Log('Read header: %s',[Header]); 108 | I := Pos(':', Header); 109 | Name := Copy(Header, 1, I - 1); 110 | Delete(Header, 1, i); 111 | Value := Trim(Header); 112 | if Name = 'Content-Length' then 113 | ContentLength := StrToIntDef(Value,0); 114 | ReadLn(aFile,Header); 115 | end; 116 | Content:=''; 117 | SetLength(Content,ContentLength); 118 | P:=PJSONCharType(Content); 119 | for I:=1 to ContentLength do 120 | begin 121 | Read(aFile,P^); 122 | inc(P); 123 | end; 124 | if Content<>'' then 125 | Result:=GetJSON(Content, True); 126 | end; 127 | 128 | Procedure SendResponse(aTransport : TMessageTransport; aContext : TLSPContext; aResponse : TJSONData; aFreeResponse : Boolean = True); 129 | 130 | Var 131 | Content : TJSONStringType; 132 | 133 | begin 134 | try 135 | if not IsResponseValid(aResponse) then 136 | begin 137 | aContext.Log('Response not valid: %s',[aResponse.AsJSON]); 138 | aTransport.SendDiagnostic('invalid response -> '+aResponse.AsJSON); 139 | exit; 140 | end; 141 | Content := aResponse.AsJSON; 142 | (aTransport as TLSPTextTransport).EmitMessage(Content); 143 | aContext.Log('Wrote response to request'); 144 | finally 145 | if aFreeResponse then 146 | aResponse.Free; 147 | end; 148 | end; 149 | 150 | Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext); 151 | 152 | var 153 | Request, Response: TJSONData; 154 | VerboseDebugging: boolean = false; 155 | IO : TLSPTextTransport; 156 | 157 | begin 158 | IO:=Nil; 159 | Request:=Nil; 160 | try 161 | if aContext.Transport is TLSPTextTransport then 162 | IO:=aContext.Transport as TLSPTextTransport 163 | else 164 | IO:=TLSPTextTransport.Create(@aOutput,@aError); 165 | while not EOF(aInput) do 166 | begin 167 | Request:=ReadRequest(aInput,aContext); 168 | // log request payload 169 | if VerboseDebugging then 170 | begin 171 | Writeln(aError, Request.FormatJSON); 172 | Flush(aError); 173 | end; 174 | Response := aContext.Execute(Request); 175 | if Assigned(Response) then 176 | begin 177 | // log response payload 178 | if VerboseDebugging then 179 | begin 180 | writeln(aError, Response.asJSON); 181 | Flush(aError); 182 | end; 183 | SendResponse(IO, aContext, Response,True); 184 | end 185 | else 186 | aContext.Log('No response to request'); 187 | FreeAndNil(Request); 188 | end; 189 | finally 190 | if IO<>aContext.Transport then 191 | IO.Free; 192 | Request.Free; 193 | end; 194 | end; 195 | 196 | { TTextLSPContext } 197 | 198 | constructor TLSPTextTransport.Create(aOutput, aError: PText); 199 | begin 200 | FOutput:=aOutput; 201 | FError:=aError; 202 | end; 203 | 204 | procedure TLSPTextTransport.EmitMessage(aMessage: TJSONStringType); 205 | begin 206 | Try 207 | WriteLn(Foutput^,'Content-Type: ', ContentType); 208 | WriteLn(Foutput^,'Content-Length: ', Length(aMessage)); 209 | WriteLn(Foutput^); 210 | Write(Foutput^,aMessage); 211 | Flush(Foutput^); 212 | except 213 | on e : exception do 214 | DoLog('Exception %s during output: %s',[E.ClassName,E.Message]); 215 | end; 216 | end; 217 | 218 | procedure TLSPTextTransport.DoSendMessage(aMessage: TJSONData); 219 | 220 | Var 221 | Content : TJSONStringType; 222 | 223 | begin 224 | Content:=aMessage.AsJSON; 225 | EmitMessage(Content); 226 | end; 227 | 228 | procedure TLSPTextTransport.DoSendDiagnostic(const aMessage: UTF8String); 229 | begin 230 | Try 231 | WriteLn(FError^,aMessage); 232 | Flush(FError^); 233 | except 234 | on e : exception do 235 | DoLog('Exception %s during diagnostic output: %s',[E.ClassName,E.Message]); 236 | end; 237 | end; 238 | 239 | 240 | 241 | end. 242 | 243 | -------------------------------------------------------------------------------- /src/protocol/lspprotocol.lpk: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | -------------------------------------------------------------------------------- /src/protocol/lspprotocol.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit lspprotocol; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | LSP.CodeAction, LSP.Diagnostics, LSP.DocumentHighlight, LSP.DocumentSymbol, 12 | LSP.ExecuteCommand, LSP.Hover, LSP.InlayHint, LSP.Basic, LSP.Capabilities, 13 | LSP.Completion, LSP.General, LSP.Base, LSP.Options, LSP.References, 14 | LSP.SignatureHelp, LSP.Synchronization, LSP.Window, LSP.WorkDoneProgress, 15 | LSP.Workspace, PasLS.TextLoop, PasLS.SocketDispatcher, LSP.Streaming, 16 | LSP.BaseTypes, LSP.Messages, LazarusPackageIntf; 17 | 18 | implementation 19 | 20 | procedure Register; 21 | begin 22 | end; 23 | 24 | initialization 25 | RegisterPackage('lspprotocol', @Register); 26 | end. 27 | -------------------------------------------------------------------------------- /src/protocol/memutils.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | {$mode objfpc} 21 | {$modeswitch autoderef} 22 | 23 | unit MemUtils; 24 | interface 25 | uses 26 | Math, Types, SysUtils, FGL; 27 | 28 | type 29 | TAutoRetainHelpers = class helper for TObject 30 | constructor Instance; 31 | function Retain: TObject; 32 | function Release: TObject; 33 | function AutoRelease: TObject; 34 | end; 35 | 36 | procedure ReleaseAndNil(var obj: TObject); 37 | procedure DrainAutoReleasePool; 38 | 39 | implementation 40 | 41 | type 42 | 43 | { TAutoReleasePool } 44 | 45 | TAutoReleasePool = class(specialize TFPGList) 46 | constructor Create; 47 | destructor Destroy; override; 48 | procedure Drain; 49 | end; 50 | 51 | { TAutoWrapper } 52 | 53 | TAutoWrapper = record 54 | obj: TObject; 55 | refCount: integer; 56 | end; 57 | PAutoWrapper = ^TAutoWrapper; 58 | TAutoWrapperMap = specialize TFPGMap; 59 | 60 | { TAutoWrapperMapHelper } 61 | 62 | TAutoWrapperMapHelper = class helper for TAutoWrapperMap 63 | function GetRef(const key: SizeUInt): PAutoWrapper; inline; 64 | end; 65 | 66 | TAutoReleasePoolList = specialize TFPGList; 67 | 68 | var 69 | AutoRetainMap: TAutoWrapperMap; 70 | AutoReleaseStack: TAutoReleasePoolList; 71 | 72 | {***************************************************************************** 73 | * Functions 74 | *****************************************************************************} 75 | 76 | procedure ReleaseAndNil(var obj: TObject); 77 | begin 78 | if assigned(obj) then 79 | begin 80 | obj.Release; 81 | obj := nil; 82 | end; 83 | end; 84 | 85 | procedure DrainAutoReleasePool; 86 | var 87 | obj: TObject; 88 | begin 89 | for obj in AutoReleaseStack.Last do 90 | obj.Release; 91 | AutoReleaseStack.Last.Clear; 92 | end; 93 | 94 | {***************************************************************************** 95 | * TAutoReleasePool 96 | *****************************************************************************} 97 | 98 | procedure TAutoReleasePool.Drain; 99 | var 100 | obj: TObject; 101 | begin 102 | for obj in self do 103 | obj.Release; 104 | Clear; 105 | end; 106 | 107 | destructor TAutoReleasePool.Destroy; 108 | begin 109 | Drain; 110 | AutoReleaseStack.Delete(AutoReleaseStack.Count - 1); 111 | inherited; 112 | end; 113 | 114 | constructor TAutoReleasePool.Create; 115 | begin 116 | AutoReleaseStack.Add(self); 117 | inherited; 118 | end; 119 | 120 | {***************************************************************************** 121 | * TAutoWrapperMapHelper 122 | *****************************************************************************} 123 | 124 | function TAutoWrapperMapHelper.GetRef(const key: SizeUInt): PAutoWrapper; 125 | begin 126 | result := TFPSMap(self).KeyData[@key]; 127 | end; 128 | 129 | {***************************************************************************** 130 | * TAutoRetainHelpers 131 | *****************************************************************************} 132 | 133 | constructor TAutoRetainHelpers.Instance; 134 | begin 135 | NewInstance; 136 | AfterConstruction; 137 | AutoRelease; 138 | end; 139 | 140 | function TAutoRetainHelpers.AutoRelease: TObject; 141 | begin 142 | Assert(AutoReleaseStack.Count > 0, 'No auto release pools are open!'); 143 | // retain and then add to open pool 144 | AutoReleaseStack.Last.Add(Retain); 145 | result := self; 146 | end; 147 | 148 | function TAutoRetainHelpers.Retain: TObject; 149 | var 150 | wrapper: TAutoWrapper; 151 | ref: PAutoWrapper; 152 | key: SizeUInt; 153 | begin 154 | key := SizeUInt(self); 155 | if not AutoRetainMap.TryGetData(key, wrapper) then 156 | begin 157 | wrapper.obj := self; 158 | wrapper.refCount := 1; 159 | AutoRetainMap[key] := wrapper; 160 | end 161 | else 162 | begin 163 | ref := AutoRetainMap.GetRef(key); 164 | ref.refCount += 1; 165 | end; 166 | result := self; 167 | end; 168 | 169 | function TAutoRetainHelpers.Release: TObject; 170 | var 171 | wrapper: PAutoWrapper; 172 | begin 173 | wrapper := AutoRetainMap.GetRef(SizeUInt(self)); 174 | dec(wrapper.refCount); 175 | if wrapper.refCount = 0 then 176 | begin 177 | wrapper.obj.Free; 178 | AutoRetainMap.Remove(SizeUInt(self)); 179 | end; 180 | result := self; 181 | end; 182 | 183 | begin 184 | AutoRetainMap := TAutoWrapperMap.Create; 185 | AutoRetainMap.Sorted := true; 186 | AutoRetainMap.Duplicates := dupAccept; 187 | AutoReleaseStack := TAutoReleasePoolList.Create; 188 | TAutoReleasePool.Create; 189 | end. -------------------------------------------------------------------------------- /src/proxy/PasLSProxy.Config.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // Socket-based protocol server - configuration options 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // . 19 | 20 | unit PasLSProxy.Config; 21 | 22 | {$mode ObjFPC}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | Classes, SysUtils, IniFiles; 28 | 29 | 30 | Const 31 | DefaultSocketUnix = ''; 32 | DefaultSocketPort = 9898; 33 | DefaultLogFile = ''; 34 | 35 | Type 36 | { TLSPProxyConfig } 37 | 38 | TLSPProxyConfig = Class(TObject) 39 | private 40 | FLogFile: String; 41 | FPort: Word; 42 | FUnix: String; 43 | Public 44 | Constructor Create; virtual; 45 | Procedure Reset; virtual; 46 | class Function DefaultConfigFile : String; 47 | Procedure LoadFromFile(const aFileName : String); 48 | Procedure SaveToFile(const aFileName : String); 49 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual; 50 | Procedure SaveToIni(aIni : TCustomIniFile); virtual; 51 | Public 52 | Property Port : Word Read FPort Write FPort; 53 | Property Unix : String Read FUnix Write FUnix; 54 | Property LogFile : String Read FLogFile Write FLogFile; 55 | end; 56 | 57 | 58 | implementation 59 | 60 | Const 61 | SProxy = 'Proxy'; 62 | KeyPort = 'Port'; 63 | KeyUnix = 'Unix'; 64 | KeyLogFile = 'LogFile'; 65 | 66 | { TLSPProxyConfig } 67 | 68 | constructor TLSPProxyConfig.Create; 69 | begin 70 | Reset; 71 | end; 72 | 73 | procedure TLSPProxyConfig.Reset; 74 | begin 75 | FPort:=DefaultSocketPort; 76 | FUnix:=DefaultSocketUnix; 77 | LogFile:=DefaultLogFile; 78 | end; 79 | 80 | class function TLSPProxyConfig.DefaultConfigFile: String; 81 | begin 82 | {$IFDEF UNIX} 83 | Result:='/etc/paslsproxy.cfg'; 84 | {$ELSE} 85 | Result:=ChangeFileExt(ParamStr(0),'.ini'); 86 | {$ENDIF} 87 | end; 88 | 89 | procedure TLSPProxyConfig.LoadFromFile(const aFileName: String); 90 | 91 | Var 92 | Ini : TCustomIniFile; 93 | 94 | begin 95 | Ini:=TMemIniFile.Create(aFileName); 96 | try 97 | LoadFromIni(Ini); 98 | finally 99 | Ini.Free; 100 | end; 101 | end; 102 | 103 | procedure TLSPProxyConfig.SaveToFile(const aFileName: String); 104 | Var 105 | Ini : TCustomIniFile; 106 | 107 | begin 108 | Ini:=TMemIniFile.Create(aFileName); 109 | try 110 | SaveToIni(Ini); 111 | Ini.UpdateFile; 112 | finally 113 | Ini.Free; 114 | end; 115 | end; 116 | 117 | procedure TLSPProxyConfig.LoadFromIni(aIni: TCustomIniFile); 118 | begin 119 | With aIni do 120 | begin 121 | FPort:=ReadInteger(SProxy,KeyPort,FPort); 122 | FUnix:=ReadString(SProxy,KeyUnix,FUnix); 123 | FLogFile:=ReadString(SProxy,KeyLogFile,LogFile); 124 | end; 125 | end; 126 | 127 | procedure TLSPProxyConfig.SaveToIni(aIni: TCustomIniFile); 128 | begin 129 | With aIni do 130 | begin 131 | WriteInteger(SProxy,KeyPort,FPort); 132 | WriteString(SProxy,KeyUnix,FUnix); 133 | WriteString(SProxy,KeyLogFile,LogFile); 134 | end; 135 | end; 136 | 137 | 138 | end. 139 | 140 | -------------------------------------------------------------------------------- /src/proxy/paslsproxy.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes> 18 | <Item Name="Default" Default="True"/> 19 | </BuildModes> 20 | <PublishOptions> 21 | <Version Value="2"/> 22 | <UseFileFilters Value="True"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <FormatVersion Value="2"/> 26 | </RunParams> 27 | <RequiredPackages> 28 | <Item> 29 | <PackageName Value="lspprotocol"/> 30 | </Item> 31 | </RequiredPackages> 32 | <Units> 33 | <Unit> 34 | <Filename Value="paslsproxy.lpr"/> 35 | <IsPartOfProject Value="True"/> 36 | </Unit> 37 | <Unit> 38 | <Filename Value="PasLSProxy.Config.pas"/> 39 | <IsPartOfProject Value="True"/> 40 | </Unit> 41 | </Units> 42 | </ProjectOptions> 43 | <CompilerOptions> 44 | <Version Value="11"/> 45 | <Target> 46 | <Filename Value="paslsproxy"/> 47 | </Target> 48 | <SearchPaths> 49 | <IncludeFiles Value="$(ProjOutDir)"/> 50 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 51 | </SearchPaths> 52 | <Linking> 53 | <Debugging> 54 | <DebugInfoType Value="dsDwarf3"/> 55 | </Debugging> 56 | </Linking> 57 | </CompilerOptions> 58 | <Debugging> 59 | <Exceptions> 60 | <Item> 61 | <Name Value="EAbort"/> 62 | </Item> 63 | <Item> 64 | <Name Value="ECodetoolError"/> 65 | </Item> 66 | <Item> 67 | <Name Value="EFOpenError"/> 68 | </Item> 69 | </Exceptions> 70 | </Debugging> 71 | </CONFIG> 72 | -------------------------------------------------------------------------------- /src/proxy/paslsproxy.lpr: -------------------------------------------------------------------------------- 1 | program paslsproxy; 2 | 3 | // Pascal Language Server proxy dispatcher 4 | // Copyright 2023 Michael Van Canneyt 5 | 6 | // This file is part of Pascal Language Server. 7 | 8 | // Pascal Language Server is free software: you can redistribute it 9 | // and/or modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation, either version 3 of 11 | // the License, or (at your option) any later version. 12 | 13 | // Pascal Language Server is distributed in the hope that it will be 14 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 15 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | 18 | // You should have received a copy of the GNU General Public License 19 | // along with Pascal Language Server. If not, see 20 | // <https://www.gnu.org/licenses/>. 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | uses 25 | {$ifdef unix} 26 | cwstring, 27 | {$endif} 28 | { RTL } 29 | SysUtils, Classes, fpjson, jsonparser, jsonscanner, 30 | ssockets, custapp, types, 31 | 32 | { LSP } 33 | 34 | LSP.Messages, LSP.Base, PasLS.TextLoop, PasLS.SocketDispatcher, 35 | 36 | { Pasls } 37 | PasLSProxy.Config; 38 | 39 | Type 40 | 41 | { TLSPProxyApplication } 42 | 43 | TLSPProxyApplication = Class(TCustomApplication) 44 | Private 45 | const 46 | ShortOptions = 'htp:u:c:l:'; 47 | LongOptions : Array of string = ('help','test','port:','unix:','config:','log:'); 48 | procedure DoHandleDiagnostic(Sender: TObject; const aFrame: TLSPFrame); 49 | Private 50 | FConfig : TLSPProxyConfig; 51 | FContext : TLSPContext; 52 | function ParseOptions(out aParams : TStringDynArray): Boolean; 53 | function SetupTransport: TLSPSocketTransport; 54 | protected 55 | procedure DoRun; override; 56 | Function ExecuteCommandLineMessages(aContext : TLSPContext; aParams : Array of string) : Boolean; 57 | 58 | public 59 | constructor Create(TheOwner: TComponent); override; 60 | destructor Destroy; override; 61 | procedure Usage(const aError: String); virtual; 62 | end; 63 | 64 | procedure TLSPProxyApplication.DoHandleDiagnostic(Sender: TObject; const aFrame: TLSPFrame); 65 | 66 | Type 67 | PFile = ^Text; 68 | 69 | var 70 | aFile : PFile; 71 | aMsg : String; 72 | 73 | begin 74 | aMsg:=aFrame.PayloadString; 75 | FContext.Log('Out of band message of type %s: %s',[aFrame.MessageType.AsString,aMsg]); 76 | case aFrame.MessageType of 77 | lptmDiagnostic: 78 | begin 79 | aFile:=@StdErr; 80 | aMsg:=aMsg+sLineBreak; 81 | end; 82 | lptmMessage: 83 | begin 84 | aFile:=@Output; 85 | WriteLn(aFile^,'Content-Type: ', ContentType); 86 | WriteLn(aFile^,'Content-Length: ', Length(aMsg)); 87 | WriteLn(aFile^); 88 | end; 89 | else 90 | aFile:=Nil; 91 | end; 92 | Write(aFile^,aMsg); 93 | Flush(aFile^); 94 | end; 95 | 96 | function TLSPProxyApplication.ExecuteCommandLineMessages(aContext: TLSPContext; 97 | aParams: array of string): Boolean; 98 | 99 | var 100 | i, len: integer; 101 | method, path : String; 102 | 103 | begin 104 | Result:=True; 105 | len:=Length(aParams); 106 | if len =0 then 107 | exit; 108 | if (Len mod 2)= 1 then 109 | begin 110 | writeln(StdErr,'Invalid parameter count of '+ParamCount.ToString+' (must be pairs of 2)'); 111 | Exit(false); 112 | end; 113 | I:=0; 114 | while (i<Len) do 115 | begin 116 | method := aParams[i]; 117 | path := ExpandFileName(aParams[i+1]); 118 | if not FileExists(path) then 119 | begin 120 | writeln(StdErr,'Command path "',path,'" can''t be found'); 121 | exit(false) 122 | end; 123 | DebugSendMessage(output,aContext, method, GetFileAsString(path)); 124 | Inc(i, 2); 125 | end; 126 | end; 127 | 128 | constructor TLSPProxyApplication.Create(TheOwner: TComponent); 129 | 130 | begin 131 | inherited Create(TheOwner); 132 | FConfig:=TLSPProxyConfig.Create; 133 | StopOnException:=True; 134 | end; 135 | 136 | destructor TLSPProxyApplication.Destroy; 137 | begin 138 | FreeAndNil(FConfig); 139 | inherited Destroy; 140 | end; 141 | 142 | procedure TLSPProxyApplication.Usage(const aError: String); 143 | 144 | begin 145 | if aError<>'' then 146 | Writeln('Error: ',aError); 147 | Writeln('Pascal Language Server Proxy [',{$INCLUDE %DATE%},']'); 148 | Writeln('Usage: ', ExeName, ' [options]'); 149 | Writeln('Where options is one or more of:'); 150 | Writeln('-h --help This help message'); 151 | Writeln('-c --config=FILE Read configuration from file FILE. Default is to read from ',TLSPProxyConfig.DefaultConfigFile); 152 | Writeln('-l --log=FILE Set log file in which to write all log messages'); 153 | Writeln('-p --port=NNN Listen on port NNN (default: ',DefaultSocketPort); 154 | Writeln('-t --test Interpret non-option arguments as call/param file pairs and send to server'); 155 | Writeln('-u --unix=FILE Listen on unix socket FILE (only on unix-like systems. Default: ',DefaultSocketUnix,')'); 156 | Writeln('Only one of -p or -u may be specified, if none is specified then the default is to listen on port 9898'); 157 | ExitCode:=Ord(aError<>''); 158 | end; 159 | 160 | 161 | function TLSPProxyApplication.ParseOptions(out aParams: TStringDynArray): Boolean; 162 | var 163 | FN : String; 164 | begin 165 | Result:=False; 166 | FN:=GetOptionValue('c','config'); 167 | if FN='' then 168 | FN:=TLSPProxyConfig.DefaultConfigFile; 169 | FConfig.LoadFromFile(FN); 170 | {$IFDEF UNIX} 171 | if HasOption('u','unix') then 172 | FConfig.Unix:=GetOptionValue('u','unix'); 173 | {$ENDIF} 174 | if HasOption('p','port') then 175 | FConfig.Port:=StrToInt(GetOptionValue('p','port')); 176 | if HasOption('l','log') then 177 | FConfig.LogFile:=GetOptionValue('l','log'); 178 | if HasOption('t','test') then 179 | aParams:=GetNonOptions(ShortOptions,LongOptions) 180 | else 181 | aParams:=[]; 182 | Result:=True; 183 | end; 184 | 185 | function TLSPProxyApplication.SetupTransport: TLSPSocketTransport; 186 | 187 | var 188 | aSock : TSocketStream; 189 | 190 | begin 191 | Result:=Nil; 192 | aSock:=Nil; 193 | SetupTextLoop(Input,Output,StdErr); 194 | TLSPContext.LogFile:=FConfig.LogFile; 195 | {$IFDEF UNIX} 196 | // Todo: Add some code to start the socket server, e.g. when the file does not exist. 197 | if FConfig.Unix<>'' then 198 | aSock:=TUnixSocket.Create(FConfig.Unix); 199 | {$ENDIF} 200 | if aSock=Nil then 201 | aSock:=TInetsocket.Create('127.0.0.1',FConfig.Port); 202 | Result:=TLSPSocketTransport.Create(aSock); 203 | Result.OnHandleFrame:=@DoHandleDiagnostic; 204 | end; 205 | 206 | procedure TLSPProxyApplication.DoRun; 207 | 208 | var 209 | aMsg : String; 210 | lParams : TStringDynArray; 211 | aTrans : TLSPSocketTransport; 212 | aDisp : TLSPClientSocketDispatcher; 213 | 214 | begin 215 | Terminate; 216 | lParams:=[]; 217 | aMsg:=CheckOptions(ShortOptions, LongOptions); 218 | if HasOption('h','help') then 219 | begin 220 | Usage(aMsg); 221 | exit; 222 | end; 223 | if not ParseOptions(lParams) then 224 | exit; 225 | aTrans:=SetupTransport; 226 | try 227 | aDisp:=TLSPClientSocketDispatcher.Create(aTrans); 228 | FContext:=TLSPContext.Create(aTrans,aDisp,True); 229 | if length(lParams)>0 then 230 | if not ExecuteCommandLineMessages(FContext,lParams) then 231 | exit; 232 | RunMessageLoop(Input,Output,StdErr,FContext); 233 | Finally 234 | FreeAndNil(FContext); 235 | end; 236 | end; 237 | 238 | var 239 | Application: TLSPProxyApplication; 240 | 241 | begin 242 | Application:=TLSPProxyApplication.Create(nil); 243 | Application.Title:='Pascal LSP Server proxy application'; 244 | Application.Run; 245 | Application.Free; 246 | end. 247 | 248 | end. 249 | 250 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.AllCommands.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server - Include all command units in a single place, so all commands are available by using this unit. 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.AllCommands; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | Procedure RegisterAllCommands; 27 | 28 | Implementation 29 | 30 | uses 31 | LSP.Base, 32 | // General init etc. 33 | PasLS.General, 34 | // Document 35 | PasLS.Hover, 36 | PasLS.GotoDeclaration, 37 | PasLS.GotoDefinition, 38 | PasLS.Completion, 39 | PasLS.GotoImplementation, 40 | PasLS.SignatureHelp, 41 | PasLS.References, 42 | PasLS.Synchronization, 43 | PasLS.CodeAction, 44 | PasLS.DocumentHighlight, 45 | PasLS.DocumentSymbol, 46 | PasLS.InlayHint, 47 | // Workspace 48 | PasLS.Workspace, 49 | // Custom commands 50 | PasLS.ExecuteCommand, 51 | PasLS.Command.FormatCode, 52 | PasLS.Command.CompleteCode, 53 | PasLS.Command.InvertAssignment, 54 | PasLS.Command.RemoveEmptyMethods; 55 | 56 | procedure RegisterAllCommands; 57 | 58 | begin 59 | // General 60 | LSPHandlerManager.RegisterHandler('initialize', TInitialize); 61 | LSPHandlerManager.RegisterHandler('initialized', TInitialized); 62 | LSPHandlerManager.RegisterHandler('shutdown', TShutdown); 63 | LSPHandlerManager.RegisterHandler('exit', TExit); 64 | LSPHandlerManager.RegisterHandler('$/cancelRequest', TCancel); 65 | // textDocument 66 | LSPHandlerManager.RegisterHandler('textDocument/declaration', TGotoDeclaraction); 67 | LSPHandlerManager.RegisterHandler('textDocument/definition', TGotoDefinition); 68 | LSPHandlerManager.RegisterHandler('textDocument/completion', TCompletion); 69 | LSPHandlerManager.RegisterHandler('textDocument/implementation', TGotoImplementation); 70 | LSPHandlerManager.RegisterHandler('textDocument/references', TReferencesRequest); 71 | LSPHandlerManager.RegisterHandler('textDocument/signatureHelp', TSignatureHelpRequest); 72 | LSPHandlerManager.RegisterHandler('textDocument/didOpen', TDidOpenTextDocument); 73 | LSPHandlerManager.RegisterHandler('textDocument/didClose', TDidCloseTextDocument); 74 | LSPHandlerManager.RegisterHandler('textDocument/didChange', TDidChangeTextDocument); 75 | LSPHandlerManager.RegisterHandler('textDocument/didSave', TDidSaveTextDocument); 76 | LSPHandlerManager.RegisterHandler('textDocument/codeAction', TCodeActionRequest); 77 | LSPHandlerManager.RegisterHandler('textDocument/documentHighlight', TDocumentHighlightRequest); 78 | LSPHandlerManager.RegisterHandler('textDocument/hover', THoverRequest); 79 | LSPHandlerManager.RegisterHandler('textDocument/inlayHint', TInlayHintRequest); 80 | LSPHandlerManager.RegisterHandler('textDocument/documentSymbol', TDocumentSymbolRequest); 81 | // WorkSpace 82 | LSPHandlerManager.RegisterHandler('workspace/didChangeConfiguration', TDidChangeConfiguration); 83 | LSPHandlerManager.RegisterHandler('workspace/didChangeWorkspaceFolders', TDidChangeWorkspaceFolders); 84 | LSPHandlerManager.RegisterHandler('workspace/symbol', TWorkspaceSymbolRequest); 85 | LSPHandlerManager.RegisterHandler('workspace/executeCommand', TExecuteCommandRequest); 86 | end; 87 | 88 | end. 89 | 90 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.ApplyEdit.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.ApplyEdit; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, SysUtils, 28 | { LSP } 29 | LSP.Messages, LSP.Basic, LSP.Base; 30 | 31 | procedure DoApplyEdit(aTransport: TMessageTransport; DocumentURI, Text: String; Range: TRange); 32 | 33 | implementation 34 | 35 | Uses 36 | { LSP } 37 | PasLS.Settings, 38 | LSP.BaseTypes, 39 | LSP.WorkSpace, PasLS.WorkSpace; 40 | 41 | procedure DoApplyEdit(aTransport: TMessageTransport; DocumentURI, Text: String; Range: TRange); 42 | var 43 | Params: TApplyWorkspaceEditParams; 44 | Edit: TWorkspaceEdit; 45 | TextEdit: TTextEdit; 46 | Msg: TWorkspaceApplyEditRequest; 47 | TextDocumentEdit: TTextDocumentEdit; 48 | begin 49 | Msg := nil; 50 | Params := TApplyWorkspaceEditParams.Create; 51 | try 52 | Edit := Params.edit; 53 | 54 | TextDocumentEdit := Edit.documentChanges.Add; 55 | TextDocumentEdit.textDocument.uri := DocumentURI; 56 | 57 | // TODO: we're hacking around clients by using the versioning system they allow 58 | // but ideally you're supposed to provided correct versions. 59 | // See `OptionalVersionedTextDocumentIdentifier` from 60 | // https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#versionedTextDocumentIdentifier 61 | if ClientInfo.name = TClients.SublimeTextLSP then 62 | TextDocumentEdit.textDocument.version := nil 63 | else 64 | TextDocumentEdit.textDocument.version := 0; 65 | 66 | TextEdit := TextDocumentEdit.edits.Add; 67 | TextEdit.range := range; 68 | TextEdit.newText := Text; 69 | 70 | Msg := TWorkspaceApplyEditRequest.Create(aTransport); 71 | Msg.Execute(params, 'workspace/applyEdit'); // TODO: the class should know it's method name 72 | finally 73 | Params.Free; 74 | Msg.Free; 75 | end; 76 | end; 77 | 78 | 79 | end. 80 | 81 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.CheckInactiveRegions.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | // 20 | // Adapted from fork at: 21 | // https://github.com/coolchyni/pascal-language-server 22 | // (codetoolsutil unit) 23 | // 24 | unit PasLS.CheckInactiveRegions; 25 | 26 | {$mode ObjFPC}{$H+} 27 | 28 | interface 29 | 30 | uses 31 | Classes, SysUtils, FileProcs, LazUtils, LazUtilities, 32 | // Codetools 33 | ExprEval,DefineTemplates,CodeToolManager,CodeCache,LinkScanner,sourcelog, 34 | BasicCodeTools, 35 | //pasls 36 | LSP.Messages; 37 | 38 | type 39 | 40 | { TCheckInactiveRegions } 41 | 42 | TCheckInactiveRegions = class 43 | private 44 | FTransport: TMessageTransport; 45 | Public 46 | Constructor Create(aTransport : TMessageTransport); 47 | procedure Execute(Code:TCodeBuffer;uri:String); 48 | Property Transport : TMessageTransport Read FTransport; 49 | end; 50 | 51 | Procedure CheckInactiveRegions(aTransport : TMessageTransport; aCode : TCodeBuffer; aURI : String); 52 | 53 | 54 | implementation 55 | 56 | uses PasLS.Settings, PasLS.InactiveRegions; 57 | 58 | Procedure CheckInactiveRegions(aTransport : TMessageTransport; aCode : TCodeBuffer; aURI : String); 59 | begin 60 | if ServerSettings.CheckInactiveRegions then 61 | With TCheckInactiveRegions.Create(aTransport) do 62 | try 63 | aTransport.SendDiagnostic('Checking inactive regions'); 64 | Execute(aCode,aURI); 65 | finally 66 | Free; 67 | end; 68 | end; 69 | 70 | constructor TCheckInactiveRegions.Create(aTransport: TMessageTransport); 71 | begin 72 | FTransport:=aTransport; 73 | end; 74 | 75 | procedure TCheckInactiveRegions.Execute(Code:TCodeBuffer;uri:String); 76 | 77 | Procedure GetDirectivePos(Scanner: TLinkScanner;Dir : PLSDirective; Out Line,Col : integer); 78 | var 79 | acode:Pointer; 80 | cursorPos:Integer; 81 | begin 82 | Scanner.CleanedPosToCursor(Dir^.CleanPos,cursorPos,acode); 83 | TSourceLog(acode).AbsoluteToLineCol(cursorPos,line,col); 84 | end; 85 | 86 | var 87 | Notification: TInactiveRegionsNotification; 88 | Regions: TRegionsItems; 89 | CurrentRegion: TInputRegion; 90 | Scanner: TLinkScanner; 91 | Dir: PLSDirective; 92 | i, line,col: Integer; 93 | DirectiveText : string; 94 | 95 | begin 96 | if (Code=nil) or Not CodeToolBoss.ExploreUnitDirectives(Code,Scanner) then 97 | exit; 98 | Notification := TInactiveRegionsNotification.Create; 99 | try 100 | Notification.InactiveRegionParams.uri:=uri; 101 | // Easy access 102 | Regions:=Notification.InactiveRegionParams.regions; 103 | CurrentRegion:=nil; 104 | for i:=0 to Scanner.DirectiveCount-1 do 105 | begin 106 | Dir:=Scanner.Directives[i]; 107 | if (Dir^.Code<>Pointer(Code)) then 108 | Continue; 109 | GetDirectivePos(Scanner,Dir,Line,Col); 110 | DirectiveText:=ExtractCommentContent(Scanner.CleanedSrc,Dir^.CleanPos,Scanner.NestedComments); 111 | Case Dir^.State of 112 | lsdsInactive: 113 | if Not Assigned(CurrentRegion) then 114 | begin 115 | CurrentRegion:=Regions.Add; 116 | CurrentRegion.startline:=line; 117 | CurrentRegion.startCol:=col+length(DirectiveText)+2; 118 | CurrentRegion.endline:=999999; // will be corrected when end of region is found 119 | end; 120 | lsdsActive: 121 | if Assigned(CurrentRegion) then 122 | begin 123 | CurrentRegion.endline:=line; 124 | CurrentRegion.endCol:=col; 125 | CurrentRegion:=Nil; 126 | end; 127 | lsdsSkipped: 128 | ; 129 | end; 130 | end; 131 | // We must always send: if after an edit the previous ranges become invalid, we need to notify the client. 132 | Notification.Send(Transport); 133 | finally 134 | Notification.Free; 135 | end; 136 | end; 137 | 138 | end. 139 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.CodeAction.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.CodeAction; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | SysUtils, Classes, 29 | { Protocol } 30 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.Streaming, LSP.CodeAction; 31 | 32 | Type 33 | { TCodeActionRequest 34 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_codeAction 35 | 36 | The code action request is sent from the client to the server to compute commands for a 37 | given text document and range. These commands are typically code fixes to either fix 38 | problems or to beautify/refactor code. The result of a textDocument/codeAction request 39 | is an array of Command literals which are typically presented in the user interface. 40 | To ensure that a server is useful in many clients the commands specified in a code actions 41 | should be handled by the server and not by the client (see workspace/executeCommand and 42 | ServerCapabilities.executeCommandProvider). If the client supports providing edits with a 43 | code action then that mode should be used. } 44 | 45 | TCodeActionRequest = class(specialize TLSPRequest<TCodeActionParams, TCodeActionItems>) 46 | function Process(var Params: TCodeActionParams): TCodeActionItems; override; 47 | end; 48 | 49 | 50 | implementation 51 | 52 | function TCodeActionRequest.Process(var Params: TCodeActionParams): TCodeActionItems; 53 | begin with Params do 54 | begin 55 | Result := nil; 56 | end; 57 | end; 58 | 59 | 60 | end. 61 | 62 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Command.CompleteCode.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Command.CompleteCode; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, SysUtils, fpJSON, 28 | { LSP } 29 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands; 30 | 31 | 32 | Type 33 | 34 | { TCompleteCodeCommand } 35 | 36 | TCompleteCodeCommand = Class(TCustomCommand) 37 | private 38 | procedure CompleteCode(DocumentURI: TDocumentUri; line, column: integer); 39 | Protected 40 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override; 41 | Public 42 | Class Function CommandName : string; override; 43 | end; 44 | 45 | implementation 46 | 47 | uses PasLS.ApplyEdit, CodeToolManager, CodeCache, SourceChanger, FindDeclarationTool; 48 | 49 | procedure TCompleteCodeCommand.CompleteCode(DocumentURI: TDocumentUri; line, column: integer); 50 | 51 | var 52 | Path: String; 53 | Code, NewCode: TCodeBuffer; 54 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: Integer; 55 | ARange: TRange; 56 | 57 | begin 58 | // https://wiki.lazarus.freepascal.org/Lazarus_IDE_Tools#Code_Completion 59 | 60 | with CodeToolBoss.SourceChangeCache.BeautifyCodeOptions do 61 | begin 62 | ClassHeaderComments := false; 63 | ClassImplementationComments := false; 64 | ForwardProcBodyInsertPolicy := fpipInFrontOfMethods; 65 | end; 66 | 67 | //Code := CodeToolBoss.LoadFile(URI.path + URI.Document, false, false); 68 | Path := UriToPath(DocumentURI); 69 | Code := CodeToolBoss.FindFile(Path); 70 | Transport.SendDiagnostic(' ▶️ complete code: '+ Path + ' Code: ' + BoolToStr(assigned(Code),'True','False')); 71 | if not CodeToolBoss.CompleteCode(Code, column, line, {TopLine}line, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine, false) then 72 | begin 73 | Transport.SendDiagnostic( '🔴 CompleteCode Failed'); 74 | Exit; 75 | end; 76 | 77 | Transport.SendDiagnostic(' ✅ Sucesss NewX: %d NewY: %d NewTopLine: %d BlockTopLine: %d BlockBottomLine: %d', [NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine]); 78 | //procedure AbsoluteToLineCol(Position: integer; out Line, Column: integer); 79 | With Code[Code.Count - 1] do 80 | Transport.SendDiagnostic( 'Position: %d : %d - Length: %d', [Position, Code.GetLineStart(Position),Len]); 81 | // TODO: we need to get character offsets and get the text out of the source 82 | aRange := TRange.Create(0, 0, MaxInt, MaxInt); 83 | try 84 | DoApplyEdit(Transport,DocumentURI, Code.Source, aRange); 85 | finally 86 | aRange.Free; 87 | end; 88 | // TODO: we can do this in one pass with multiple TTextEdits! 89 | // move the cursor 90 | //ApplyEdit(DocumentURI, '', TRange.Create({NewY, NewX}0,0)); 91 | 92 | // TODO: goto line next 93 | //pascal-language-server: ✅ Sucesss NewX:3 NewY:83 NewTopLine: 81 BlockTopLine: 81 BlockBottomLine: 84 94 | //range := TRange.Create(NewY, NewX, ) 95 | end; 96 | 97 | { TCompleteCodeCommand } 98 | 99 | function TCompleteCodeCommand.DoExecute(aArguments: TJSONArray): TLSPStreamable; 100 | 101 | var 102 | DocumentURI : String; 103 | Position : TPosition; 104 | 105 | begin 106 | Result:=Nil; 107 | documentURI := aArguments.Strings[0]; 108 | position := specialize TLSPStreaming<TPosition>.ToObject(aArguments.Objects[1].AsJSON); 109 | try 110 | CompleteCode(documentURI, position.line, position.character); 111 | finally 112 | Position.Free; 113 | end; 114 | end; 115 | 116 | class function TCompleteCodeCommand.CommandName: string; 117 | begin 118 | Result:='pasls.completeCode'; 119 | end; 120 | 121 | 122 | Initialization 123 | TCompleteCodeCommand.Register; 124 | end. 125 | 126 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Command.FormatCode.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Command.FormatCode; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | Classes, SysUtils,fpjson, 27 | LSP.BaseTypes, LSP.Base, LSP.Basic, PasLS.Commands; 28 | 29 | Type 30 | 31 | { TFormatCommand } 32 | 33 | TFormatCommand = Class(TCustomCommand) 34 | Protected 35 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override; 36 | Public 37 | Class Function CommandName : string; override; 38 | end; 39 | 40 | implementation 41 | 42 | uses PasLS.Formatter; 43 | 44 | { TFormatCommand } 45 | 46 | function TFormatCommand.DoExecute(aArguments: TJSONArray): TLSPStreamable; 47 | 48 | var 49 | Formatter : TFileFormatter; 50 | FilePath,ConfPath : String; 51 | begin 52 | Result:=Nil; 53 | FilePath := UriToPath(aArguments.Strings[0]); 54 | ConfPath := UriToPath(aArguments.Strings[1]); 55 | Formatter:=TFileFormatter.Create(Transport); 56 | try 57 | Formatter.Process(FilePath,ConfPath); 58 | finally 59 | Formatter.Free; 60 | end; 61 | end; 62 | 63 | class function TFormatCommand.CommandName: string; 64 | begin 65 | Result:='pasls.formatCode'; 66 | end; 67 | 68 | initialization 69 | TFormatCommand.Register; 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Command.InvertAssignment.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Command.InvertAssignment; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | Classes, SysUtils, fpJSON, 27 | { LSP } 28 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands; 29 | 30 | 31 | Type 32 | 33 | { TInvertAssignmentCommand } 34 | 35 | TInvertAssignmentCommand = Class(TCustomCommand) 36 | private 37 | procedure InvertAssignment(DocumentURI: TDocumentUri; Range: TRange); 38 | Protected 39 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override; 40 | Public 41 | Class Function CommandName : string; override; 42 | end; 43 | 44 | implementation 45 | 46 | uses PasLS.InvertAssign, PasLS.ApplyEdit, CodeToolManager, CodeCache, FindDeclarationTool; 47 | 48 | { TInvertAssignmentCommand } 49 | 50 | procedure TInvertAssignmentCommand.InvertAssignment(DocumentURI: TDocumentUri; Range: TRange); 51 | 52 | var 53 | Path,S,SL : String; 54 | Code : TCodeBuffer; 55 | I : TInvertAssignment; 56 | 57 | begin 58 | Path := UriToPath(DocumentURI); 59 | Code := CodeToolBoss.FindFile(Path); 60 | if Assigned(Code) then 61 | begin 62 | S:=''; 63 | if (Range.start.line<Range.&end.line) then 64 | begin 65 | S:=Code.GetLines(Range.start.line+1,Range.&end.line); 66 | if Range.start.character>0 then 67 | Delete(S,1,Range.start.character); 68 | end; 69 | SL:=Code.GetLine(Range.&end.line); 70 | S:=S+Copy(SL,1,Range.&end.Character+1); 71 | I:=TInvertAssignment.Create; 72 | try 73 | S:=I.InvertAssignment(S); 74 | DoApplyEdit(Transport,DocumentURI,S,Range); 75 | finally 76 | I.Free; 77 | end; 78 | end; 79 | end; 80 | 81 | function TInvertAssignmentCommand.DoExecute(aArguments: TJSONArray 82 | ): TLSPStreamable; 83 | 84 | var 85 | documentURI : String; 86 | range : TRange; 87 | ePos,sPos : TPosition; 88 | begin 89 | Result:=Nil; 90 | documentURI := aArguments.Strings[0]; 91 | Range:=Nil; 92 | ePos:=Nil; 93 | sPos:=specialize TLSPStreaming<TPosition>.ToObject(aArguments.Objects[1].AsJSON); 94 | try 95 | ePos:=specialize TLSPStreaming<TPosition>.ToObject(aArguments.Objects[2].AsJSON); 96 | Range:=TRange.Create; 97 | Range.Start:=sPos; 98 | Range.&End:=ePos; 99 | InvertAssignment(documentURI,Range); 100 | finally 101 | sPos.Free; 102 | ePos.Free; 103 | Range.Free; 104 | end; 105 | end; 106 | 107 | class function TInvertAssignmentCommand.CommandName: string; 108 | begin 109 | Result:='pasls.invertAssignment'; 110 | end; 111 | 112 | initialization 113 | TInvertAssignmentCommand.Register; 114 | end. 115 | 116 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Command.RemoveEmptyMethods.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Command.RemoveEmptyMethods; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | Classes, SysUtils, fpJSON, 27 | { LSP } 28 | LSP.Streaming, LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.Messages, PasLS.Commands; 29 | 30 | 31 | Type 32 | 33 | { TRemoveEmptymethodsCommand } 34 | 35 | TRemoveEmptymethodsCommand = Class(TCustomCommand) 36 | private 37 | procedure RemoveEmptymethods(DocumentURI: TDocumentUri; aPos : TPosition); 38 | Protected 39 | Function DoExecute(aArguments: TJSONArray): TLSPStreamable; override; 40 | Public 41 | Class Function CommandName : string; override; 42 | end; 43 | 44 | implementation 45 | 46 | uses PasLS.RemoveEmptyMethods; 47 | 48 | { TRemoveEmptymethodsCommand } 49 | 50 | procedure TRemoveEmptymethodsCommand.RemoveEmptymethods( 51 | DocumentURI: TDocumentUri; aPos: TPosition); 52 | 53 | var 54 | Rem: TRemoveEmptyMethods; 55 | 56 | begin 57 | Rem:=TRemoveEmptyMethods.Create(Transport); 58 | try 59 | Rem.Execute(documentURI,aPos); 60 | finally 61 | Rem.Free; 62 | end; 63 | end; 64 | 65 | function TRemoveEmptymethodsCommand.DoExecute(aArguments: TJSONArray 66 | ): TLSPStreamable; 67 | 68 | var 69 | documentURI : String; 70 | position : TPosition; 71 | 72 | begin 73 | Result:=nil; 74 | documentURI := aArguments.Strings[0]; 75 | position := specialize TLSPStreaming<TPosition>.ToObject(aArguments.Objects[1].AsJSON); 76 | try 77 | RemoveEmptymethods(documentUri,Position); 78 | finally 79 | Position.Free; 80 | end; 81 | end; 82 | 83 | class function TRemoveEmptymethodsCommand.CommandName: string; 84 | begin 85 | Result:='pasls.removeEmptyMethods'; 86 | end; 87 | 88 | initialization 89 | TRemoveEmptymethodsCommand.Register; 90 | end. 91 | 92 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Commands.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.Commands; 21 | 22 | {$mode objfpc}{$H+} 23 | {$codepage UTF8} 24 | 25 | interface 26 | uses 27 | { RTL } 28 | SysUtils, Classes, Types, FPJSON, 29 | { LSP } 30 | LSP.BaseTypes, LSP.Messages ; 31 | 32 | Type 33 | 34 | { TCustomCommand } 35 | 36 | TCustomCommand = class 37 | private 38 | FTransport: TMessageTransport; 39 | Protected 40 | function DoExecute(aArguments : TJSONArray) : TLSPStreamable; virtual; abstract; 41 | Public 42 | class Function CommandName : String; virtual; 43 | class Procedure Register; 44 | class procedure UnRegister; 45 | Constructor Create(aTransport : TMessageTransport); virtual; 46 | function Execute(aArguments : TJSONArray) : TLSPStreamable; 47 | Property Transport : TMessageTransport Read FTransport; 48 | end; 49 | TCustomCommandClass = class of TCustomCommand; 50 | 51 | { TCommandDef } 52 | 53 | TCommandDef = Class(TCollectionItem) 54 | private 55 | FClass: TCustomCommandClass; 56 | function GetCommandName: String; 57 | Public 58 | property CommandClass : TCustomCommandClass Read FClass Write FClass; 59 | Property CommandName : String Read GetCommandName; 60 | end; 61 | 62 | { TCommandDefs } 63 | 64 | TCommandDefs = Class(TCollection) 65 | private 66 | FCommandCount: Integer; 67 | function GetDef(aIndex: Integer): TCommandDef; 68 | procedure SetDef(aIndex: Integer; AValue: TCommandDef); 69 | Public 70 | function Add(aCommandClass : TCustomCommandClass) : TCommandDef; 71 | function IndexOfCommandClass(aCommandClass : TCustomCommandClass) : Integer; 72 | function IndexOfCommand(const aName : String) : Integer; 73 | function FindCommand(const aName: String): TCommandDef; 74 | function FindCommandClass(aCommandClass : TCustomCommandClass): TCommandDef; 75 | function Remove(aCommandClass : TCustomCommandClass) : Boolean; 76 | Property Commands[aIndex: Integer] : TCommandDef Read GetDef Write SetDef; default; 77 | Property CommandCount : Integer Read FCommandCount; 78 | end; 79 | 80 | { TCommandFactory } 81 | 82 | TCommandFactory = class 83 | private 84 | class var _instance : TCommandFactory; 85 | private 86 | FList : TCommandDefs; 87 | public 88 | Class Constructor Init; 89 | Class Destructor Done; 90 | Constructor Create; 91 | Destructor Destroy; override; 92 | Procedure RegisterCommand(aCommand : TCustomCommandClass); 93 | Procedure UnregisterCommand(aCommand : TCustomCommandClass); 94 | Function FindCommand(const aName : String) : TCommandDef; 95 | Function FindCommandClass(const aName : String) : TCustomCommandClass; 96 | Procedure GetCommandList(L : TStrings); 97 | Function GetCommandNames : TStringDynArray; 98 | Class Property Instance : TCommandFactory Read _Instance; 99 | end; 100 | 101 | Function CommandFactory : TCommandFactory; 102 | 103 | 104 | implementation 105 | uses 106 | CodeToolManager, 107 | FindDeclarationTool, 108 | 109 | { Protocols } 110 | LSP.Workspace, PasLS.Settings; 111 | 112 | function CommandFactory: TCommandFactory; 113 | begin 114 | Result:=TCommandFactory.Instance; 115 | end; 116 | 117 | 118 | 119 | 120 | { TCustomCommand } 121 | 122 | class function TCustomCommand.CommandName: String; 123 | begin 124 | Result:=ClassName; 125 | if Result[1]='T' then 126 | Delete(Result,1,1); 127 | end; 128 | 129 | class procedure TCustomCommand.Register; 130 | begin 131 | TCommandFactory.Instance.RegisterCommand(Self); 132 | end; 133 | 134 | class procedure TCustomCommand.UnRegister; 135 | begin 136 | TCommandFactory.Instance.UnRegisterCommand(Self); 137 | end; 138 | 139 | constructor TCustomCommand.Create(aTransport: TMessageTransport); 140 | begin 141 | FTransport:=aTransport; 142 | end; 143 | 144 | function TCustomCommand.Execute(aArguments: TJSONArray): TLSPStreamable; 145 | begin 146 | // Maybe later we can add some logging etc. here. 147 | Result:=DoExecute(aArguments); 148 | end; 149 | 150 | { TCommandDef } 151 | 152 | function TCommandDef.GetCommandName: String; 153 | begin 154 | Result:=''; 155 | if Assigned(CommandClass) then 156 | Result:=CommandClass.CommandName; 157 | end; 158 | 159 | { TCommandDefs } 160 | 161 | function TCommandDefs.GetDef(aIndex: Integer): TCommandDef; 162 | begin 163 | Result:=Items[aIndex] as TCommandDef; 164 | end; 165 | 166 | procedure TCommandDefs.SetDef(aIndex: Integer; AValue: TCommandDef); 167 | begin 168 | Items[aIndex]:=aValue; 169 | end; 170 | 171 | function TCommandDefs.Add(aCommandClass: TCustomCommandClass): TCommandDef; 172 | begin 173 | if IndexOfCommand(aCommandClass.CommandName)<>-1 then 174 | Raise EListError.CreateFmt('Duplicate command: %s',[aCommandClass.CommandName]); 175 | Result:=(Inherited Add) as TCommandDef; 176 | Result.CommandClass:=aCommandClass; 177 | end; 178 | 179 | function TCommandDefs.IndexOfCommandClass(aCommandClass: TCustomCommandClass 180 | ): Integer; 181 | begin 182 | Result:=Count-1; 183 | While (Result>=0) and (GetDef(Result).CommandClass<>aCommandClass) do 184 | Dec(Result); 185 | end; 186 | 187 | function TCommandDefs.IndexOfCommand(const aName: String): Integer; 188 | begin 189 | Result:=Count-1; 190 | While (Result>=0) and Not SameText(GetDef(Result).CommandName,aName) do 191 | Dec(Result); 192 | end; 193 | 194 | function TCommandDefs.FindCommand(const aName: String): TCommandDef; 195 | 196 | var 197 | Idx : Integer; 198 | 199 | begin 200 | Result:=nil; 201 | Idx:=IndexOfCommand(aName); 202 | If Idx<>-1 then 203 | Result:=Commands[Idx]; 204 | end; 205 | 206 | function TCommandDefs.FindCommandClass(aCommandClass: TCustomCommandClass 207 | ): TCommandDef; 208 | var 209 | Idx : Integer; 210 | 211 | begin 212 | Result:=nil; 213 | Idx:=IndexOfCommandClass(aCommandClass); 214 | If Idx<>-1 then 215 | Result:=Commands[Idx]; 216 | end; 217 | 218 | function TCommandDefs.Remove(aCommandClass: TCustomCommandClass): Boolean; 219 | 220 | var 221 | Def : TCommandDef; 222 | 223 | begin 224 | Def:=FindCommandClass(aCommandClass); 225 | Result:=Def<>Nil; 226 | if Result then 227 | Def.Free; 228 | end; 229 | 230 | { TCommandFactory } 231 | 232 | class constructor TCommandFactory.Init; 233 | begin 234 | _Instance:=TCommandFactory.Create 235 | end; 236 | 237 | class destructor TCommandFactory.Done; 238 | begin 239 | FreeAndNil(_Instance); 240 | end; 241 | 242 | constructor TCommandFactory.Create; 243 | begin 244 | FList:=TCommandDefs.Create(TCommandDef); 245 | end; 246 | 247 | destructor TCommandFactory.Destroy; 248 | begin 249 | FreeAndNil(FList); 250 | inherited Destroy; 251 | end; 252 | 253 | procedure TCommandFactory.RegisterCommand(aCommand: TCustomCommandClass); 254 | 255 | begin 256 | FList.Add(aCommand); 257 | end; 258 | 259 | procedure TCommandFactory.UnregisterCommand(aCommand: TCustomCommandClass); 260 | begin 261 | FList.Remove(aCommand); 262 | end; 263 | 264 | function TCommandFactory.FindCommand(const aName: String): TCommandDef; 265 | begin 266 | Result:=FList.FindCommand(aName); 267 | end; 268 | 269 | function TCommandFactory.FindCommandClass(const aName: String): TCustomCommandClass; 270 | 271 | var 272 | aDef : TCommandDef; 273 | 274 | begin 275 | Result:=nil; 276 | aDef:=FindCommand(aName); 277 | if Assigned(aDef) then 278 | Result:=aDef.CommandClass; 279 | end; 280 | 281 | procedure TCommandFactory.GetCommandList(L: TStrings); 282 | 283 | Var 284 | i : Integer; 285 | 286 | begin 287 | For I:=0 to FList.Count-1 do 288 | L.Add(FList[i].CommandName); 289 | end; 290 | 291 | function TCommandFactory.GetCommandNames: TStringDynArray; 292 | 293 | var 294 | L : TStrings; 295 | 296 | begin 297 | L:=TStringList.Create; 298 | try 299 | GetCommandList(L); 300 | Result:=L.ToStringArray; 301 | finally 302 | L.Free; 303 | end; 304 | end; 305 | 306 | end. 307 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.DocumentHighlight.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.DocumentHighlight; 21 | 22 | 23 | {$mode objfpc}{$H+} 24 | {$scopedenums on} 25 | 26 | interface 27 | 28 | uses 29 | { RTL } 30 | SysUtils, Classes, 31 | { Code Tools } 32 | CodeToolManager, CodeCache, 33 | { Protocol } 34 | LSP.Base, LSP.Basic, 35 | { Other } 36 | LSP.BaseTypes, PasLS.CodeUtils, LSP.DocumentHighlight; 37 | 38 | Type 39 | { TDocumentHighlightRequest 40 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_documentHighlight 41 | 42 | The document highlight request is sent from the client to the server to resolve a 43 | document highlights for a given text document position. For programming languages 44 | this usually highlights all references to the symbol scoped to this file. 45 | However we kept `textDocument/documentHighlight` and `textDocument/references` 46 | separate requests since the first one is allowed to be more fuzzy. 47 | Symbol matches usually have a DocumentHighlightKind of Read or Write whereas fuzzy or 48 | textual matches use Textas the kind. } 49 | 50 | TDocumentHighlightRequest = class(specialize TLSPRequest<TDocumentHighlightParams, TDocumentHighlightItems>) 51 | function Process(var Params: TDocumentHighlightParams): TDocumentHighlightItems; override; 52 | end; 53 | 54 | implementation 55 | 56 | 57 | function TDocumentHighlightRequest.Process(var Params: TDocumentHighlightParams): TDocumentHighlightItems; 58 | var 59 | Code: TCodeBuffer; 60 | X, Y: Integer; 61 | NewCode: TCodeBuffer; 62 | NewX, NewY, NewTopLine: integer; 63 | 64 | begin 65 | Result:=TDocumentHighlightItems.Create; 66 | with Params do 67 | begin 68 | Code := CodeToolBoss.FindFile(textDocument.LocalPath); 69 | X := position.character + 1; 70 | Y := position.line + 1; 71 | 72 | if CodeToolBoss.FindBlockCounterPart(Code, X, Y, NewCode, NewX, NewY, NewTopLine) then 73 | begin 74 | // Show start/end indentifier if the range spans more than 1 line 75 | if NewY - Y <> 0 then 76 | begin 77 | TDocumentHighlight.Create(Result,TDocumentHighlightKind.Text, GetIdentifierRangeAtPos(NewCode, NewX, NewY - 1)); 78 | TDocumentHighlight.Create(Result,TDocumentHighlightKind.Text, GetIdentifierRangeAtPos(NewCode, X, Y - 1)) 79 | end 80 | else 81 | begin 82 | // TODO: make this an option to show single line ranges? 83 | //Item := TDocumentHighlight(Result.Add); 84 | //Item.kind := TDocumentHighlightKind.Text; 85 | //Item.range := TRange.Create(NewY - 1, NewX - 1, Y - 1, X - 1); 86 | end; 87 | end 88 | else 89 | end; 90 | end; 91 | 92 | 93 | end. 94 | 95 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.DocumentSymbol.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.DocumentSymbol; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, FPJson, FPJsonRPC, 28 | { Code Tools } 29 | CodeToolManager, LinkScanner, 30 | { Protocol } 31 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.Streaming, LSP.DocumentSymbol; 32 | 33 | Type 34 | { The document symbol request is sent from the client to the server. The returned result is either: 35 | 36 | * SymbolInformation[] which is a flat list of all symbols found in a given text document. 37 | Then neither the symbol’s location range nor the symbol’s container name should be used to infer a hierarchy. 38 | * DocumentSymbol[] which is a hierarchy of symbols found in a given text document. } 39 | 40 | TDocumentSymbolRequest = class(specialize TLSPRequest<TDocumentSymbolParams, TLSPStreamable>) 41 | function DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; override; 42 | end; 43 | 44 | 45 | implementation 46 | 47 | uses 48 | { RTL } 49 | SysUtils, FileUtil, DateUtils, fpjsonrtti, 50 | { Code Tools } 51 | 52 | FindDeclarationTool, KeywordFuncLists, 53 | { Protocol } 54 | PasLS.Symbols; 55 | 56 | 57 | { TDocumentSymbolRequest } 58 | 59 | function TDocumentSymbolRequest.DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; 60 | var 61 | Input: TDocumentSymbolParams; 62 | Path: String; 63 | begin 64 | Input := specialize TLSPStreaming<TDocumentSymbolParams>.ToObject(Params); 65 | try 66 | Path := Input.textDocument.LocalPath; 67 | Result := SymbolManager.FindDocumentSymbols(Path); 68 | if not Assigned(Result) then 69 | Result := TJSONNull.Create; 70 | finally 71 | Input.Free; 72 | end; 73 | end; 74 | 75 | 76 | end. 77 | 78 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.ExecuteCommand.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.ExecuteCommand; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | SysUtils, Classes, FPJSON, 28 | { Protocol } 29 | LSP.BaseTypes, LSP.Base, LSP.Streaming, LSP.WorkDoneProgress, LSP.ExecuteCommand; 30 | 31 | Type 32 | { TExecuteCommandRequest 33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspace_executeCommand 34 | 35 | The `workspace/executeCommand` request is sent from the client to the server to trigger 36 | command execution on the server. In most cases the server creates a `WorkspaceEdit` structure 37 | and applies the changes to the workspace using the request `workspace/applyEdit` which is sent 38 | from the server to the client. 39 | 40 | Response: 41 | 42 | result: LSPAny | null 43 | error: code and message set in case an exception happens during the request. 44 | } 45 | 46 | TExecuteCommandRequest = class(specialize TLSPRequest<TExecuteCommandParams, TLSPStreamable>) 47 | function Process(var Params: TExecuteCommandParams): TLSPStreamable; override; 48 | end; 49 | 50 | 51 | implementation 52 | 53 | uses 54 | PasLS.Commands; 55 | 56 | function TExecuteCommandRequest.Process(var Params: TExecuteCommandParams): TLSPStreamable; 57 | var 58 | aCommandClass : TCustomCommandClass; 59 | aCommand : TCustomCommand; 60 | 61 | begin 62 | result := nil; 63 | aCommandClass:=CommandFactory.FindCommandClass(Params.command); 64 | if aCommandClass<>Nil then 65 | try 66 | aCommand:=aCommandClass.Create(Self.Transport); 67 | result:=aCommand.Execute(Params.Arguments); 68 | finally 69 | aCommand.Free; 70 | end; 71 | { case command of 72 | 'pasls.formatCode': 73 | begin 74 | end; 75 | 'pasls.invertAssignment': 76 | begin 77 | end; 78 | end;} 79 | 80 | end; 81 | 82 | initialization 83 | 84 | 85 | end. 86 | 87 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.GotoDeclaration.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.GotoDeclaration; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, CodeToolManager, CodeCache, 29 | { Protocol } 30 | LSP.Base, LSP.Basic; 31 | 32 | type 33 | 34 | { TGotoDeclaraction } 35 | 36 | TGotoDeclaraction = class(specialize TLSPRequest<TTextDocumentPositionParams, TLocation>) 37 | function Process(var Params: TTextDocumentPositionParams): TLocation; override; 38 | end; 39 | 40 | implementation 41 | 42 | uses 43 | PasLS.Diagnostics; 44 | 45 | function TGotoDeclaraction.Process(var Params: TTextDocumentPositionParams): TLocation; 46 | var 47 | Code: TCodeBuffer; 48 | NewCode: TCodeBuffer; 49 | X, Y: Integer; 50 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer; 51 | 52 | begin with Params do 53 | begin 54 | Code := CodeToolBoss.FindFile(textDocument.LocalPath); 55 | X := position.character; 56 | Y := position.line; 57 | 58 | if CodeToolBoss.FindDeclaration(Code, X + 1, Y + 1, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine) then 59 | begin 60 | Result := TLocation.Create(NewCode.Filename,NewY - 1,NewX-1,0); 61 | end 62 | else 63 | begin 64 | Result := nil; 65 | PublishCodeToolsError(Transport,''); 66 | end; 67 | end; 68 | end; 69 | 70 | end. 71 | 72 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.GotoDefinition.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.GotoDefinition; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, 29 | { Code Tools } 30 | CodeToolManager, CodeCache, 31 | { Protocol } 32 | LSP.Base, LSP.Basic; 33 | 34 | type 35 | 36 | { TGotoDefinition } 37 | 38 | TGotoDefinition = class(specialize TLSPRequest<TTextDocumentPositionParams, TLocation>) 39 | function Process(var Params: TTextDocumentPositionParams): TLocation; override; 40 | end; 41 | 42 | implementation 43 | 44 | uses 45 | PasLS.Diagnostics; 46 | 47 | function TGotoDefinition.Process(var Params: TTextDocumentPositionParams): TLocation; 48 | var 49 | Code: TCodeBuffer; 50 | NewCode: TCodeBuffer; 51 | X, Y: Integer; 52 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer; 53 | begin with Params do 54 | begin 55 | Code := CodeToolBoss.FindFile(textDocument.localPath); 56 | X := position.character; 57 | Y := position.line; 58 | { 59 | NOTE: currently goto definition is supported as goto declaration 60 | 61 | There is a definition for the following identifiers: 62 | 63 | - Methods 64 | 65 | There is no definition for the following identifiers: 66 | 67 | - Function forwards 68 | - Functions in the interface section 69 | - External functions 70 | - Class forwards 71 | - External ObjC classes 72 | 73 | https://www.cprogramming.com/declare_vs_define.html 74 | https://stackoverflow.com/questions/1410563/what-is-the-difference-between-a-definition-and-a-declaration 75 | } 76 | if CodeToolBoss.FindDeclaration(Code, X + 1, Y + 1, NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine) then 77 | begin 78 | Result := TLocation.Create(NewCode.Filename,NewY - 1, NewX - 1,0) 79 | end 80 | else 81 | begin 82 | Result := nil; 83 | PublishCodeToolsError(Transport,''); 84 | end; 85 | end; 86 | end; 87 | 88 | end. 89 | 90 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.GotoImplementation.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.GotoImplementation; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | Classes, 29 | { Code Tools } 30 | CodeToolManager, CodeCache, 31 | { Protocol } 32 | LSP.Base, LSP.Basic; 33 | 34 | type 35 | 36 | { TGotoImplementation } 37 | 38 | TGotoImplementation = class(specialize TLSPRequest<TTextDocumentPositionParams, TLocation>) 39 | function Process(var Params: TTextDocumentPositionParams): TLocation; override; 40 | end; 41 | 42 | implementation 43 | 44 | uses 45 | PasLS.Diagnostics, LSP.Diagnostics; 46 | 47 | function TGotoImplementation.Process(var Params: TTextDocumentPositionParams): TLocation; 48 | var 49 | Code: TCodeBuffer; 50 | NewCode: TCodeBuffer; 51 | X, Y: Integer; 52 | NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine: integer; 53 | RevertableJump: boolean; 54 | begin with Params do 55 | begin 56 | Code := CodeToolBoss.FindFile(TextDocument.LocalPath); 57 | X := position.character; 58 | Y := position.line; 59 | 60 | if CodeToolBoss.JumpToMethod(Code, X + 1, Y + 1, 61 | NewCode, NewX, NewY, NewTopLine, BlockTopLine, BlockBottomLine, RevertableJump) then 62 | begin 63 | Result := TLocation.Create(NewCode.Filename,NewY - 1, NewX - 1,0); 64 | end 65 | else 66 | begin 67 | PublishCodeToolsError(Transport,''); 68 | Result := nil; 69 | end; 70 | end; 71 | end; 72 | 73 | end. 74 | 75 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Hover.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Hover; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { Code Tools } 27 | CodeToolManager, CodeCache, 28 | { Protocol } 29 | LSP.BaseTypes,LSP.Base, LSP.Hover, LSP.Basic; 30 | 31 | Type 32 | { THoverRequest } 33 | 34 | THoverRequest = class(specialize TLSPRequest<TTextDocumentPositionParams, THoverResponse>) 35 | function Process(var Params: TTextDocumentPositionParams): THoverResponse; override; 36 | end; 37 | 38 | 39 | implementation 40 | 41 | uses 42 | SysUtils; 43 | 44 | function THoverRequest.Process(var Params: TTextDocumentPositionParams): THoverResponse; 45 | var 46 | 47 | Code: TCodeBuffer; 48 | X, Y: Integer; 49 | Hint: String; 50 | begin with Params do 51 | begin 52 | Code := CodeToolBoss.FindFile(textDocument.LocalPath); 53 | X := position.character; 54 | Y := position.line; 55 | 56 | try 57 | Hint := CodeToolBoss.FindSmartHint(Code, X + 1, Y + 1); 58 | // empty hint string means nothing was found 59 | if Hint = '' then 60 | exit(nil); 61 | except 62 | on E: Exception do 63 | begin 64 | LogError('Hover Error',E); 65 | exit(nil); 66 | end; 67 | end; 68 | 69 | // https://facelessuser.github.io/sublime-markdown-popups/ 70 | // Wrap hint in markdown code 71 | Hint:='```pascal'+#10+Hint+#10+'```'; 72 | 73 | Result := THoverResponse.Create; 74 | Result.contents.PlainText:=False; 75 | Result.contents.value:=Hint; 76 | Result.range.SetRange(Y, X); 77 | end; 78 | end; 79 | 80 | 81 | end. 82 | 83 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.InactiveRegions.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.InactiveRegions; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { Rtl } 28 | SysUtils, Classes, 29 | { Pasls } 30 | LSP.Base, LSP.BaseTypes, LSP.Messages; 31 | 32 | type 33 | { TInputRegion } 34 | TInputRegion = class(TCollectionItem) 35 | private 36 | fStartline:Integer; 37 | fStartCol:Integer; 38 | fEndline:Integer; 39 | fEndCol:Integer; 40 | Public 41 | Procedure Assign(aSource : TPersistent); override; 42 | published 43 | property startLine: Integer read fStartline write fStartline; 44 | property startCol: Integer read fStartCol write fStartCol; 45 | property endLine: Integer read fEndline write fEndline; 46 | property endCol: Integer read fEndCol write fEndCol; 47 | end; 48 | 49 | TRegionsItems = specialize TGenericCollection<TInputRegion>; 50 | 51 | { TInactiveRegionParams } 52 | 53 | TInactiveRegionParams=class(TLSPStreamable) 54 | private 55 | fUri:string; 56 | fFileVersion:Integer; 57 | fRegions:TRegionsItems; 58 | procedure SetRegions(AValue: TRegionsItems); 59 | Public 60 | Constructor Create; override; 61 | Destructor Destroy; override; 62 | published 63 | property uri : string read fUri write fUri; 64 | property fileVersion : Integer read fFileVersion write fFileVersion; 65 | property regions : TRegionsItems read fRegions write SetRegions; 66 | end; 67 | 68 | 69 | { TInactiveRegionsNotification } 70 | { The message notification is sent from a server to a client to ask 71 | the client to display a inactive region in the user interface. } 72 | 73 | TInactiveRegionsNotification = class(TNotificationMessage) 74 | private 75 | function GetParams: TInactiveRegionParams; 76 | public 77 | constructor Create; override; 78 | Property InactiveRegionParams: TInactiveRegionParams Read GetParams; 79 | destructor Destroy; override; 80 | end; 81 | 82 | implementation 83 | 84 | { TInputRegion } 85 | 86 | procedure TInputRegion.Assign(aSource: TPersistent); 87 | 88 | var 89 | Reg : TInputRegion absolute aSource; 90 | 91 | begin 92 | if (aSource is TInputRegion) then 93 | begin 94 | Startline:=Reg.Startline; 95 | StartCol:=Reg.StartCol; 96 | Endline:=Reg.EndLine; 97 | EndCol:=Reg.EndCol; 98 | end 99 | else 100 | inherited Assign(aSource); 101 | end; 102 | 103 | { TInactiveRegionParams } 104 | 105 | procedure TInactiveRegionParams.SetRegions(AValue: TRegionsItems); 106 | begin 107 | if fRegions=AValue then Exit; 108 | fRegions.Assign(AValue); 109 | end; 110 | 111 | constructor TInactiveRegionParams.Create; 112 | begin 113 | inherited Create; 114 | fRegions:=TRegionsItems.Create; 115 | end; 116 | 117 | destructor TInactiveRegionParams.Destroy; 118 | begin 119 | FreeAndNil(fRegions); 120 | inherited Destroy; 121 | end; 122 | 123 | function TInactiveRegionsNotification.GetParams: TInactiveRegionParams; 124 | begin 125 | Result:=(Inherited Params) as TInactiveRegionParams 126 | end; 127 | 128 | constructor TInactiveRegionsNotification.Create; 129 | begin 130 | params := TInactiveRegionParams.Create; 131 | method := 'pasls.inactiveRegions'; 132 | end; 133 | 134 | destructor TInactiveRegionsNotification.Destroy; 135 | begin 136 | FreeAndNil(fparams); 137 | inherited; 138 | end; 139 | 140 | end. 141 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.InlayHint.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2022 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.InlayHint; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, SysUtils, 28 | { LSP Protocol } 29 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.InlayHint; 30 | 31 | Type 32 | { TInlayHintRequest 33 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_inlayHint 34 | 35 | The inlay hints request is sent from the client to the server to compute inlay hints for a given [text document, range] tuple that may be rendered in the editor in place with other text. } 36 | 37 | TInlayHintRequest = class(specialize TLSPRequest<TInlayHintParams, TInlayHints>) 38 | function Process(var Params: TInlayHintParams): TInlayHints; override; 39 | end; 40 | 41 | 42 | implementation 43 | 44 | { TInlayHintRequest } 45 | 46 | function TInlayHintRequest.Process(var Params: TInlayHintParams): TInlayHints; 47 | {var 48 | hint: TInlayHint;} 49 | begin with Params do 50 | //hint := TInlayHint(result.Add); 51 | //hint.position := TPosition.Create(0, 0); 52 | //hint.&label := 'number'; 53 | //hint.tooltip := 'paramter name tooltip'; 54 | result := TInlayHints.Create; 55 | end; 56 | 57 | end. 58 | 59 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.InvertAssign.pas: -------------------------------------------------------------------------------- 1 | { 2 | *************************************************************************** 3 | * * 4 | * This source is free software; you can redistribute it and/or modify * 5 | * it under the terms of the GNU General Public License as published by * 6 | * the Free Software Foundation; either version 2 of the License, or * 7 | * (at your option) any later version. * 8 | * * 9 | * This code is distributed in the hope that it will be useful, but * 10 | * WITHOUT ANY WARRANTY; without even the implied warranty of * 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * 12 | * General Public License for more details. * 13 | * * 14 | * A copy of the GNU General Public License is available on the World * 15 | * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also * 16 | * obtain it by writing to the Free Software Foundation, * 17 | * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * 18 | * * 19 | *************************************************************************** 20 | 21 | Author: Sérgio Marcelo S. Gomes <smace at smace.com.br> 22 | Modified by Andrew Haines and Juha Manninen 23 | Adapted for LSP by Michael Van Canneyt <michael at freepascal.org> 24 | 25 | Abstract: Invert Assignment Code. 26 | 27 | Example: AValue := BValue -> BValue := AValue; 28 | AValue := True -> AValue := False; 29 | 30 | } 31 | unit PasLS.InvertAssign; 32 | 33 | {$mode objfpc}{$H+} 34 | 35 | interface 36 | 37 | uses 38 | Classes, SysUtils; 39 | 40 | type 41 | 42 | { TInvertAssignment } 43 | TInvertAssignOption = (iaoSpaceBefore,iaoSpaceAfter,iaoAlign); 44 | TInvertAssignOptions = set of TInvertAssignOption; 45 | 46 | TInvertAssignment = Class 47 | private 48 | FOptions: TInvertAssignOptions; 49 | class procedure DivideLines(Lines: TStrings; var PreList, AList, BList, PostList: TStrings); virtual; 50 | class function GetIndent(ALine: String): Integer; virtual; 51 | class function IsAWholeLine(const ALine: String): Boolean; virtual; 52 | function InvertLine(PreVar, VarA, VarB, PostVar: String; LineStart, EqualPosition: Integer): String; virtual; 53 | Public 54 | function InvertAssignment(InText: string): string; 55 | procedure InvertAssignment(Lines: TStrings); 56 | Property Options : TInvertAssignOptions Read FOptions Write FOptions; 57 | end; 58 | 59 | implementation 60 | 61 | 62 | class function TInvertAssignment.GetIndent(ALine: String):Integer; 63 | begin 64 | Result := Length(Aline) - Length(TrimLeft(ALine)); 65 | end; 66 | 67 | class procedure TInvertAssignment.DivideLines(Lines: TStrings; var PreList, AList, BList, PostList: TStrings); 68 | var 69 | ALine, TrueFalse: String; 70 | t, f: Boolean; 71 | X, I, EqPos, SemiPos, WordEndPos, BracketCount: Integer; 72 | begin 73 | for X := 0 to Lines.Count-1 do begin 74 | ALine := Trim(Lines[X]); 75 | EqPos := Pos(':=', ALine); 76 | if EqPos > 0 then begin 77 | SemiPos := Pos(';', ALine); 78 | if SemiPos = 0 then 79 | SemiPos:=Length(ALine)+1; 80 | I := EqPos-1; 81 | while (I > 0) and (ALine[I] = ' ') do // Skip initial spaces 82 | Dec(I); 83 | WordEndPos := I+1; 84 | BracketCount := 0; 85 | // Get the word before := 86 | while I > 0 do begin 87 | if ALine[I] = ']' then 88 | Inc(BracketCount) 89 | else if ALine[I] = '[' then 90 | Dec(BracketCount); 91 | if (BracketCount = 0) and (ALine[I] = ' ') then 92 | Break; 93 | Dec(I); 94 | end; 95 | // I points now at beginning of word - 1 96 | Alist.Add(Copy(ALine, I+1, WordEndPos-(I+1))); 97 | BList.Add(Trim(Copy(ALine, EqPos+2, SemiPos-EqPos-2))); 98 | PreList.Add(Trim(Copy(ALine,1, I))); 99 | PostList.Add(Trim(Copy(ALine, SemiPos, Length(ALine)-(SemiPos-1)))); 100 | if Length(PreList[X]) > 0 then 101 | PreList[X] := PreList[X] + ' '; 102 | end 103 | else begin // not a valid line 104 | PreList.Add(''); 105 | AList.Add(ALine); 106 | Blist.Add(''); 107 | PostList.Add(''); 108 | end; 109 | // Check if is being assigned true or false 110 | t := CompareText(BList[X], 'True') = 0; 111 | f := CompareText(BList[X], 'False') = 0; 112 | if t or f then begin 113 | TrueFalse := AList[X]; 114 | AList[X] := BoolToStr(not t, 'True', 'False'); 115 | BList[X] := TrueFalse; 116 | end; 117 | end; 118 | end; 119 | 120 | function TInvertAssignment.InvertLine(PreVar, VarA, VarB, PostVar: String; 121 | LineStart, EqualPosition: Integer): String; 122 | var 123 | fLength: Integer; 124 | op : string; 125 | 126 | begin 127 | Result := StringOfChar(' ',LineStart); 128 | if Length(Trim(VarB)) = 0 then // is not a line with a ':=' 129 | Result := Result + VarA 130 | else 131 | begin 132 | Result := Result + PreVar + VarB; 133 | fLength := Length(Trim(Result)); 134 | if (iaoAlign in Options) and (fLength < EqualPosition) then 135 | Result := Result + StringOfChar(' ', EqualPosition-fLength) ; 136 | Op:=':='; 137 | if iaoSpaceBefore in Options then 138 | op:=' '+op; 139 | if iaoSpaceAfter in Options then 140 | op:=op+' '; 141 | Result := Result + Op + VarA + PostVar; 142 | end; 143 | end; 144 | 145 | class function TInvertAssignment.IsAWholeLine(const ALine: String): Boolean; 146 | 147 | var 148 | S : String; 149 | 150 | begin 151 | // This function is useful for when the text is put back 152 | // in the synedit, things like this don't happen: 153 | // begin 154 | // if CallSomeFunction > 0 155 | // then 156 | // DoThis 157 | // else 158 | // Exit; 159 | // end; 160 | // 161 | // Would otherwise become this 162 | // 163 | // begin if CallSomeFunction > 0 then DoThis else exit; 164 | // end; 165 | Result := False; 166 | S:=LowerCase(aLine); 167 | if (Pos(';', ALine) > 0) 168 | or (Pos('if ', S) > 0) 169 | or (Pos('begin', S) > 0) 170 | or (Pos('end', S) > 0) 171 | or (Pos('then', S) > 0) 172 | or (Pos('else', ALine) > 0) 173 | or (Pos('and', ALine) > 0) 174 | or (Pos('or', ALine) > 0) 175 | or (Pos('//', ALine) > 0) 176 | then Result := True; 177 | end; 178 | 179 | 180 | // This function inverts all Assignments operation. 181 | // like valuea := valueb; to valueb := valuea; 182 | // or valuea := False; to valuea := True; 183 | function TInvertAssignment.InvertAssignment(InText: string): string; 184 | var 185 | InLines : TStringList; 186 | HasLinefeed: Boolean; 187 | 188 | begin 189 | if InText = '' then 190 | Exit(''); 191 | HasLinefeed := InText[Length(InText)] in [#10,#13]; 192 | InLines := TStringList.Create; 193 | InLines.SkipLastLineBreak:=True; 194 | InLines.Text := InText; 195 | InvertAssignment(InLines); 196 | Result := InLines.Text; 197 | InLines.Free; 198 | if not HasLinefeed then begin 199 | while Result[Length(Result)] in [#10,#13] do 200 | SetLength(Result, Length(Result)-1); 201 | end; 202 | end; 203 | 204 | procedure TInvertAssignment.InvertAssignment(Lines: TStrings); 205 | 206 | var 207 | TempLines: TStringList; 208 | PreList, AList, BList, PostList: TStrings; 209 | ALine: String; 210 | Indents: array of integer; 211 | X, Y, EqPos: Integer; 212 | 213 | 214 | begin 215 | PreList:=Nil; 216 | AList:=Nil; 217 | BList:=Nil; 218 | PostList:=Nil; 219 | TempLines:=nil; 220 | Indents:=Nil; 221 | try 222 | SetLength(Indents, Lines.Count); 223 | TempLines := TStringList.Create; 224 | 225 | // Join many lines to one 226 | ALine := ''; 227 | for X := 0 to Lines.Count-1 do begin 228 | ALine := ALine + Lines[X]; 229 | if IsAWholeLine(ALine) then begin 230 | Indents[TempLines.Add(ALine)] := GetIndent(ALine); 231 | ALine := ''; 232 | end; 233 | end; 234 | if Length(ALine) > 0 then 235 | Indents[TempLines.Add(ALine)] := GetIndent(ALine); 236 | 237 | Lines.Clear; 238 | PreList := TStringList.Create; 239 | AList := TStringList.Create; 240 | BList := TStringList.Create; 241 | PostList := TStringList.Create; 242 | 243 | DivideLines(TempLines, PreList, AList, BList, PostList); 244 | 245 | // Find where the ':=' should be 246 | EqPos := 0; 247 | for X := 0 to BList.Count-1 do begin 248 | Y := Length(BList[X]); 249 | if Y > EqPos then 250 | EqPos := Y; 251 | end; 252 | 253 | for X := 0 to AList.Count-1 do 254 | Lines.Add(InvertLine(PreList[X],Alist[X],BList[X],PostList[X],Indents[X],EqPos)); 255 | 256 | finally 257 | PreList.Free; 258 | AList.Free; 259 | BList.Free; 260 | PostList.Free; 261 | TempLines.Free; 262 | end; 263 | end; 264 | 265 | end. 266 | 267 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.References.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.References; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | { RTL } 28 | SysUtils, Classes, 29 | { Code Tools } 30 | CodeToolManager, CodeCache, CTUnitGraph, 31 | { LazUtils } 32 | LazFileUtils, Laz_AVL_Tree, 33 | { Protocol } 34 | LSP.BaseTypes, LSP.Base, LSP.Basic, LSP.General, LSP.Messages, LSP.References; 35 | 36 | Type 37 | { TReferencesRequest } 38 | 39 | { The references request is sent from the client to the server to resolve 40 | project-wide references for the symbol denoted by the given text document position. } 41 | 42 | TReferencesRequest = class(specialize TLSPRequest<TReferenceParams, TLocationItems>) 43 | procedure FindReferences(Filename, MainFilename: String; X, Y: Integer; Items: TLocationItems); 44 | function Process(var Params: TReferenceParams): TLocationItems; override; 45 | end; 46 | 47 | 48 | implementation 49 | 50 | uses 51 | PasLS.Settings, PasLS.Diagnostics; 52 | 53 | procedure TReferencesRequest.FindReferences(Filename, MainFilename: String; X, Y: Integer; Items: TLocationItems); 54 | var 55 | DeclCode, StartSrcCode, Code: TCodeBuffer; 56 | ListOfPCodeXYPosition: TFPList; 57 | DeclX, DeclY, DeclTopLine, i: Integer; 58 | Identifier: string; 59 | Graph: TUsesGraph; 60 | Cache: TFindIdentifierReferenceCache; 61 | TreeOfPCodeXYPosition: Laz_AVL_Tree.TAVLTree; 62 | ANode, Node: Laz_AVL_Tree.TAVLTreeNode; 63 | CodePos: PCodeXYPosition; 64 | Files: TStringList; 65 | Completed: boolean; 66 | UGUnit: TUGUnit; 67 | Loc: TLocationItem; 68 | begin 69 | 70 | // Step 1: load the file 71 | StartSrcCode:=CodeToolBoss.LoadFile(Filename,false,false); 72 | 73 | // Step 2: find the main declaration 74 | if not CodeToolBoss.FindMainDeclaration(StartSrcCode, 75 | X,Y, 76 | DeclCode,DeclX,DeclY,DeclTopLine) then 77 | begin 78 | PublishCodeToolsError(Transport,'FindMainDeclaration failed in '+StartSrcCode.FileName+' at '+IntToStr(Y)+':'+IntToStr(X)); 79 | ExitCode:=-1; 80 | exit; 81 | end; 82 | 83 | // Step 3: get identifier 84 | CodeToolBoss.GetIdentifierAt(DeclCode,DeclX,DeclY,Identifier); 85 | DoLog('Found identifier: %s',[Identifier]); 86 | 87 | // Step 4: collect all modules of program 88 | Files:=TStringList.Create; 89 | ListOfPCodeXYPosition:=nil; 90 | TreeOfPCodeXYPosition:=nil; 91 | Cache:=nil; 92 | try 93 | Files.Add(DeclCode.Filename); 94 | if CompareFilenames(DeclCode.Filename,StartSrcCode.Filename)<>0 then 95 | Files.Add(DeclCode.Filename); 96 | 97 | // parse all used units 98 | Graph:=CodeToolBoss.CreateUsesGraph; 99 | try 100 | Graph.AddStartUnit(MainFilename); 101 | Graph.AddTargetUnit(DeclCode.Filename); 102 | Graph.Parse(true,Completed); 103 | Node:=Laz_AVL_Tree.TAVLTreeNode(Graph.FilesTree.FindLowest); // here explicitly casting the return 104 | while Node<>nil do begin 105 | UGUnit:=TUGUnit(Node.Data); 106 | Files.Add(UGUnit.Filename); 107 | Node:=Laz_AVL_Tree.TAVLTreeNode(Node.Successor); // same, casting return explicitly 108 | end; 109 | finally 110 | Graph.Free; 111 | end; 112 | 113 | // Step 5: find references in all files 114 | for i:=0 to Files.Count-1 do begin 115 | DoLog('Searching "%s"...',[Files[i]]); 116 | Code:=CodeToolBoss.LoadFile(Files[i],true,false); 117 | if Code=nil then begin 118 | DoLog('unable to load "%s"',[Files[i]]); 119 | continue; 120 | end; 121 | // search references 122 | CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition); 123 | if not CodeToolBoss.FindReferences( 124 | DeclCode,DeclX,DeclY, 125 | Code, true, ListOfPCodeXYPosition, Cache) then 126 | begin 127 | PublishCodeToolsError(Transport,'FindReferences failed in "'+Code.Filename+'"'); 128 | continue; 129 | end; 130 | if ListOfPCodeXYPosition=nil then continue; 131 | // In order to show all references after any parser error, they are 132 | // collected in a tree 133 | if TreeOfPCodeXYPosition=nil then 134 | TreeOfPCodeXYPosition:=Laz_AVL_Tree.TAVLTree(CodeToolBoss.CreateTreeOfPCodeXYPosition); 135 | CodeToolBoss.AddListToTreeOfPCodeXYPosition(ListOfPCodeXYPosition, 136 | TreeOfPCodeXYPosition,true,false); 137 | end; 138 | 139 | // Step 6: show references 140 | if TreeOfPCodeXYPosition=nil then begin 141 | // No references found 142 | exit; 143 | end; 144 | ANode:=Laz_AVL_Tree.TAVLTreeNode(TreeOfPCodeXYPosition.FindHighest); 145 | while ANode<>nil do begin 146 | CodePos:=PCodeXYPosition(ANode.Data); 147 | Loc := Items.Add; 148 | Loc.URI := PathToURI(CodePos^.Code.Filename); 149 | Loc.Range.SetRange(CodePos^.Y - 1, CodePos^.X - 1); 150 | { With CodePos^ do 151 | DoLog('Found: %s @ %d,%d', [Code.Filename, Y,X]);} 152 | ANode:=Laz_AVL_Tree.TAVLTreeNode(TreeOfPCodeXYPosition.FindPrecessor(ANode)); 153 | end; 154 | 155 | finally 156 | Files.Free; 157 | CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition); 158 | CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition); 159 | Cache.Free; 160 | end; 161 | end; 162 | 163 | { TReferencesRequest } 164 | 165 | function TReferencesRequest.Process(var Params: TReferenceParams): TLocationItems; 166 | var 167 | Path: String; 168 | X, Y: Integer; 169 | 170 | begin with Params do 171 | begin 172 | Path := textDocument.LocalPath; 173 | X := position.character; 174 | Y := position.line; 175 | 176 | Result := TLocationItems.Create; 177 | // if the main program file was provided via initializationOptions -> program 178 | // then use this unit as the root for searching, otherwise default to the 179 | // current text document 180 | if ServerSettings.&program <> '' then 181 | FindReferences(Path, ServerSettings.&program, X + 1, Y + 1, Result) 182 | else 183 | FindReferences(Path, Path, X + 1, Y + 1, Result); 184 | end; 185 | end; 186 | 187 | end. 188 | 189 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.RemoveEmptyMethods.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.RemoveEmptyMethods; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, SysUtils, 28 | { Codetools } 29 | CodeToolManager, CodeCache, 30 | { LSP } 31 | LSP.Messages, LSP.Basic, LSP.Base; 32 | 33 | Type 34 | 35 | { TRemoveEmptyMethods } 36 | 37 | TRemoveEmptyMethods = Class(TObject) 38 | private 39 | FTransport: TMessageTransport; 40 | Public 41 | Constructor Create(aTransport : TMessageTransport); 42 | Procedure Execute(const aDocumentURI : String; aPosition: TPosition); virtual; 43 | Property Transport : TMessageTransport Read FTransport; 44 | end; 45 | 46 | implementation 47 | 48 | uses 49 | { codetools } 50 | PascalParserTool, CodeToolsStructs, 51 | { LSP } 52 | PasLS.ApplyEdit; 53 | 54 | { TRemoveEmptyMethods } 55 | 56 | constructor TRemoveEmptyMethods.Create(aTransport: TMessageTransport); 57 | begin 58 | FTransport:=aTransport; 59 | end; 60 | 61 | procedure TRemoveEmptyMethods.Execute(const aDocumentURI: String; 62 | aPosition: TPosition); 63 | 64 | Const 65 | Attributes = 66 | [phpAddClassName,phpDoNotAddSemicolon,phpWithoutParamList, 67 | phpWithoutBrackets,phpWithoutClassKeyword,phpWithoutSemicolon]; 68 | 69 | var 70 | aList : TFPList; 71 | allEmpty : Boolean; 72 | aX,aY : Integer; 73 | Msg : String; 74 | RemovedProcHeads: TStrings; 75 | Code : TCodeBuffer; 76 | aRange : TRange; 77 | 78 | begin 79 | Code:=CodeToolBoss.FindFile(URIToPath(aDocumentUri)); 80 | if Code=Nil then 81 | begin 82 | Transport.SendDiagnostic('Cannot find file %s',[aDocumentURI]); 83 | exit; 84 | end; 85 | aY:=aPosition.line+1; 86 | aX:=aPosition.character+1; 87 | RemovedProcHeads:=Nil; 88 | aList:=TFPList.Create; 89 | try 90 | // check whether cursor is in a class 91 | if not CodeToolBoss.FindEmptyMethods(Code,'',aX,aY,AllPascalClassSections,aList,AllEmpty) then 92 | begin 93 | Msg:=CodeToolBoss.ErrorMessage; 94 | if Msg='' then 95 | Msg:='No class at caret position'; 96 | Transport.SendDiagnostic('Cannot find empty methods in file %s: %s',[aDocumentURI,Msg]); 97 | exit; 98 | end; 99 | if not CodeToolBoss.RemoveEmptyMethods(Code,'',aX,aY,AllPascalClassSections,AllEmpty, Attributes, RemovedProcHeads) then 100 | Transport.SendDiagnostic('Failed to remove empty methods in file %s',[aDocumentURI]) 101 | else 102 | begin 103 | aRange := TRange.Create(0, 0, MaxInt, MaxInt); 104 | try 105 | DoApplyEdit(Transport,aDocumentURI, Code.Source, aRange); 106 | finally 107 | aRange.Free; 108 | end; 109 | end; 110 | finally 111 | CodeToolBoss.FreeListOfPCodeXYPosition(aList); 112 | RemovedProcHeads.Free; 113 | end; 114 | end; 115 | 116 | 117 | 118 | end. 119 | 120 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.SignatureHelp.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.SignatureHelp; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL } 27 | Classes, 28 | { Code Tools } 29 | CodeToolManager, CodeCache, IdentCompletionTool, 30 | { Protocol } 31 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.SignatureHelp; 32 | 33 | Type 34 | { TSignatureHelpRequest 35 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#textDocument_signatureHelp 36 | 37 | Signature help represents the signature of something 38 | callable. There can be multiple signature but only one 39 | active and only one active parameter. } 40 | 41 | TSignatureHelpRequest = class(specialize TLSPRequest<TTextDocumentPositionParams, TSignatureHelp>) 42 | function Process(var Params: TTextDocumentPositionParams): TSignatureHelp; override; 43 | end; 44 | 45 | 46 | implementation 47 | 48 | uses 49 | { RTL } 50 | SysUtils, PasLS.CodeUtils, 51 | { Code Tools} 52 | FindDeclarationTool, CodeTree, PascalParserTool, 53 | { Protocol } 54 | PasLS.Diagnostics; 55 | 56 | 57 | { TSignatureHelpRequest } 58 | 59 | function TSignatureHelpRequest.Process(var Params: TTextDocumentPositionParams): TSignatureHelp; 60 | 61 | procedure ExtractProcParts(CurContext: TCodeContextInfoItem; out Code: String; out ParamList: TStringList); 62 | var 63 | Params, ResultType: String; 64 | CurExprType: TExpressionType; 65 | CodeNode: TCodeTreeNode; 66 | CodeTool: TFindDeclarationTool; 67 | i: integer; 68 | begin 69 | ParamList := nil; 70 | CurExprType := CurContext.Expr; 71 | Code := ExpressionTypeDescNames[CurExprType.Desc]; 72 | if CurExprType.Context.Node <> nil then 73 | begin 74 | CodeNode := CurExprType.Context.Node; 75 | CodeTool := CurExprType.Context.Tool; 76 | case CodeNode.Desc of 77 | ctnProcedure: 78 | begin 79 | ResultType := CodeTool.ExtractProcHead(CodeNode, [ 80 | phpWithoutClassName, // skip classname 81 | phpWithoutName, // skip function name 82 | phpWithoutGenericParams,// skip <> after proc name 83 | phpWithoutParamList, // skip param list 84 | phpWithoutParamTypes, // skip colon, param types and default values 85 | phpWithoutBrackets, // skip start- and end-bracket of parameter list 86 | phpWithoutSemicolon, // skip semicolon at end 87 | phpWithResultType]); 88 | 89 | Params := CodeTool.ExtractProcHead(CodeNode, 90 | [phpWithoutName, 91 | phpWithoutBrackets, 92 | phpWithoutSemicolon, 93 | phpWithVarModifiers, 94 | phpWithParameterNames, 95 | phpWithDefaultValues]); 96 | 97 | if Params <> '' then 98 | begin 99 | ParamList := ParseParamList(Params); 100 | // rebuild the param list into a single string 101 | Params := '('; 102 | for i := 0 to ParamList.Count - 1 do 103 | begin 104 | Params += ParamList[i]; 105 | if I < ParamList.Count - 1 then 106 | Params += '; '; 107 | end; 108 | Params += ')'; 109 | end; 110 | 111 | Code := Params+ResultType; 112 | end; 113 | end; 114 | end; 115 | end; 116 | 117 | var 118 | 119 | Code: TCodeBuffer; 120 | X, Y, I, ItemIndex: Integer; 121 | CodeContext: TCodeContextInfo; 122 | Item: TCodeContextInfoItem; 123 | Signature: TSignatureInformation; 124 | 125 | Parameter: TParameterInformation; 126 | Head: String; 127 | ParamList: TStringList; 128 | begin 129 | Result:=Nil; 130 | with Params do 131 | begin 132 | Code := CodeToolBoss.FindFile(URIToPath(textDocument.uri)); 133 | X := position.character; 134 | Y := position.line; 135 | CodeContext := nil; 136 | try 137 | if not CodeToolBoss.FindCodeContext(Code, X + 1, Y + 1, CodeContext) or (CodeContext = nil) or (CodeContext.Count = 0) then 138 | begin 139 | PublishCodeToolsError(Transport,''); 140 | exit(nil); 141 | end; 142 | 143 | Result := TSignatureHelp.Create; 144 | 145 | // TODO: how do we know which one is active given the current parameters? 146 | Result.activeSignature := 0; 147 | 148 | for ItemIndex := 0 to CodeContext.Count - 1 do 149 | begin 150 | Item := CodeContext[ItemIndex]; 151 | ExtractProcParts(Item, Head, ParamList); 152 | 153 | Signature := Result.signatures.Add; 154 | Signature.&label := CodeContext.ProcName+Head; 155 | 156 | if ParamList <> nil then 157 | begin 158 | for I := 0 to ParamList.Count - 1 do 159 | begin 160 | Parameter := Signature.Parameters.Add; 161 | Parameter.&label := ParamList[I]; 162 | end; 163 | ParamList.Free; 164 | end; 165 | end; 166 | 167 | Result.activeParameter := CodeContext.ParameterIndex - 1; 168 | except 169 | on E: Exception do 170 | begin 171 | Transport.SendDiagnostic('Signature Error: %s %s',[E.ClassName,E.Message]); 172 | end; 173 | end; 174 | 175 | FreeAndNil(CodeContext); 176 | end; 177 | end; 178 | 179 | end. 180 | 181 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Synchronization.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Arjan Adriaanse 3 | // Copyright 2020 Ryan Joseph 4 | 5 | // This file is part of Pascal Language Server. 6 | 7 | // Pascal Language Server is free software: you can redistribute it 8 | // and/or modify it under the terms of the GNU General Public License 9 | // as published by the Free Software Foundation, either version 3 of 10 | // the License, or (at your option) any later version. 11 | 12 | // Pascal Language Server is distributed in the hope that it will be 13 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 14 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | // GNU General Public License for more details. 16 | 17 | // You should have received a copy of the GNU General Public License 18 | // along with Pascal Language Server. If not, see 19 | // <https://www.gnu.org/licenses/>. 20 | unit PasLS.Synchronization; 21 | 22 | {$mode objfpc}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | Classes, DateUtils, 28 | CodeToolManager, CodeCache, 29 | LSP.BaseTypes, LSP.Base, LSP.Basic, PasLS.Symbols, LSP.Synchronization; 30 | 31 | Type 32 | { TDidOpenTextDocument } 33 | 34 | TDidOpenTextDocument = class(specialize TLSPNotification<TDidOpenTextDocumentParams>) 35 | procedure Process(var Params : TDidOpenTextDocumentParams); override; 36 | end; 37 | 38 | { TDidSaveTextDocument } 39 | 40 | TDidSaveTextDocument = class(specialize TLSPNotification<TDidSaveTextDocumentParams>) 41 | procedure Process(var Params : TDidSaveTextDocumentParams); override; 42 | end; 43 | 44 | 45 | { TDidCloseTextDocument } 46 | 47 | TDidCloseTextDocument = class(specialize TLSPNotification<TDidCloseTextDocumentParams>) 48 | procedure Process(var Params : TDidCloseTextDocumentParams); override; 49 | end; 50 | { TDidChangeTextDocument } 51 | 52 | TDidChangeTextDocument = class(specialize TLSPNotification<TDidChangeTextDocumentParams>) 53 | procedure Process(var Params : TDidChangeTextDocumentParams); override; 54 | end; 55 | 56 | 57 | implementation 58 | 59 | uses PasLS.CheckInactiveRegions, PasLS.Diagnostics; 60 | 61 | { TDidChangeTextDocument } 62 | 63 | procedure TDidChangeTextDocument.Process(var Params : TDidChangeTextDocumentParams); 64 | var 65 | Code: TCodeBuffer; 66 | Change: TCollectionItem; 67 | { Range: TRange; 68 | StartPos, EndPos: integer;} 69 | 70 | 71 | begin with Params do 72 | begin 73 | Code := CodeToolBoss.FindFile(textDocument.LocalPath); 74 | for Change in contentChanges do 75 | begin 76 | // note(ryan): can't get this working yet 77 | // and I'm not even sure if it's worth it 78 | { 79 | Range := TTextDocumentContentChangeEvent(Change).range; 80 | if Range <> nil then 81 | begin 82 | //Code.LineColToPosition(Range.start.line + 1, Range.start.character + 1, StartPos); 83 | //Code.LineColToPosition(Range.&end.line + 1, Range.&end.character + 1, EndPos); 84 | DoLog('insert: %d -> %d text=%s',[StartPos,EndPos, TTextDocumentContentChangeEvent(Change).text]); 85 | //Code.Replace(StartPos, EndPos - StartPos, TTextDocumentContentChangeEvent(Change).text); 86 | end 87 | else } 88 | Code.Source := TTextDocumentContentChangeEvent(Change).text; 89 | 90 | // Ryan, uncomment this to have a syntax check at 91 | // CheckSyntax(Self.Transport,Code); 92 | 93 | //if SymbolManager <> nil then 94 | // SymbolManager.FileModified(Code); 95 | end; 96 | // DoLog( 'Synched text in %d ms',[MilliSecondsBetween(Now, StartTime)]); 97 | end; 98 | end; 99 | 100 | { TDidCloseTextDocument } 101 | 102 | procedure TDidCloseTextDocument.Process(var Params : TDidCloseTextDocumentParams); 103 | 104 | 105 | begin with Params do 106 | begin 107 | // URI := ParseURI(textDocument.uri); 108 | // TODO: clear errors 109 | // TODO: if the file was manually loaded (i.e. not in search paths) 110 | // then we may want to remove it from the symbol table so it doesn't cause clutter 111 | end; 112 | end; 113 | 114 | 115 | { TDidSaveTextDocument } 116 | 117 | procedure TDidSaveTextDocument.Process(var Params : TDidSaveTextDocumentParams); 118 | var 119 | Code: TCodeBuffer; 120 | begin 121 | 122 | Code := CodeToolBoss.FindFile(Params.textDocument.LocalPath); 123 | if SymbolManager <> nil then 124 | SymbolManager.FileModified(Code); 125 | DiagnosticsHandler.CheckSyntax(Transport,Code); 126 | CheckInactiveRegions(Transport, Code, Params.textDocument.uri); 127 | // ClearDiagnostics(Transport,Code); 128 | 129 | end; 130 | 131 | 132 | { TDidOpenTextDocument } 133 | 134 | procedure TDidOpenTextDocument.Process(var Params : TDidOpenTextDocumentParams); 135 | var 136 | 137 | Path: String; 138 | Code: TCodeBuffer; 139 | begin with Params do 140 | begin 141 | Path := textDocument.LocalPath; 142 | 143 | Code := CodeToolBoss.FindFile(Path); 144 | if Code <> nil then 145 | Code.Source := textDocument.text; 146 | 147 | // the file was not found in search paths so 148 | // it need to be loaded from disk 149 | if Code = nil then 150 | Code := CodeToolBoss.LoadFile(Path, False, False); 151 | 152 | DiagnosticsHandler.CheckSyntax(Transport,Code); 153 | 154 | CheckInactiveRegions(Transport, Code, textDocument.uri); 155 | //if SymbolManager <> nil then 156 | // SymbolManager.FileModified(Code); 157 | if SymbolManager <> nil then 158 | SymbolManager.Reload(Code, True); 159 | end; 160 | end; 161 | 162 | end. 163 | 164 | -------------------------------------------------------------------------------- /src/serverprotocol/PasLS.Workspace.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Ryan Joseph 3 | 4 | // This file is part of Pascal Language Server. 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | unit PasLS.Workspace; 20 | 21 | {$mode objfpc}{$H+} 22 | 23 | interface 24 | 25 | uses 26 | { RTL} 27 | Classes, SysUtils, fpJSON, 28 | { LSP Protocol } 29 | LSP.Base, LSP.Basic, LSP.BaseTypes, LSP.General, LSP.DocumentSymbol, fpjsonrpc, 30 | PasLS.Settings, PasLS.Symbols, LSP.Streaming, LSP.Workspace; 31 | 32 | Type 33 | { TDidChangeWorkspaceFolders } 34 | 35 | { The workspace/didChangeWorkspaceFolders notification is sent from the client to the server 36 | to inform the server about workspace folder configuration changes. The notification is sent 37 | by default if both client capability workspace.workspaceFolders and the server capability 38 | workspace.workspaceFolders.supported are true; or if the server has registered itself to 39 | receive this notification. To register for the workspace/didChangeWorkspaceFolders send 40 | a client/registerCapability request from the server to the client. The registration parameter 41 | must have a registrations item of the following form, where id is a unique id used to 42 | unregister the capability (the example uses a UUID): } 43 | 44 | TDidChangeWorkspaceFolders = class(specialize TLSPNotification<TDidChangeWorkspaceFoldersParams>) 45 | procedure Process(var Params : TDidChangeWorkspaceFoldersParams); override; 46 | end; 47 | { TWorkspaceSymbolRequest } 48 | 49 | { The workspace symbol request is sent from the client to the server to 50 | list project-wide symbols matching the query string. } 51 | 52 | TWorkspaceSymbolRequest = class(specialize TLSPRequest<TWorkspaceSymbolParams, TSymbolInformationItems>) 53 | function DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; override; 54 | end; 55 | { TDidChangeConfiguration } 56 | 57 | { A notification sent from the client to the server to signal the change of configuration settings. } 58 | 59 | TDidChangeConfiguration = class(specialize TLSPNotification<TDidChangeConfigurationParams>) 60 | procedure Process(var Params: TDidChangeConfigurationParams); override; 61 | end; 62 | 63 | { TWorkspaceApplyEditRequest 64 | https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspace_applyEdit 65 | 66 | The `workspace/applyEdit` request is sent from the server to the client to 67 | modify resource on the client side. } 68 | 69 | TWorkspaceApplyEditRequest = class(specialize TLSPOutgoingRequest<TApplyWorkspaceEditParams>); 70 | 71 | implementation 72 | 73 | { TDidChangeWorkspaceFolders } 74 | 75 | procedure TDidChangeWorkspaceFolders.Process(var Params : TDidChangeWorkspaceFoldersParams); 76 | begin 77 | end; 78 | 79 | { TWorkspaceSymbolRequest } 80 | 81 | function TWorkspaceSymbolRequest.DoExecute(const Params: TJSONData; AContext: TJSONRPCCallContext): TJSONData; 82 | var 83 | Input: TWorkspaceSymbolParams; 84 | 85 | begin 86 | Input := specialize TLSPStreaming<TWorkspaceSymbolParams>.ToObject(Params); 87 | Result := SymbolManager.FindWorkspaceSymbols(Input.query); 88 | if not Assigned(Result) then 89 | Result := TJSONNull.Create; 90 | end; 91 | 92 | { TDidChangeConfiguration } 93 | 94 | procedure TDidChangeConfiguration.Process(var Params: TDidChangeConfigurationParams); 95 | begin 96 | end; 97 | 98 | 99 | end. 100 | 101 | -------------------------------------------------------------------------------- /src/serverprotocol/lspserver.lpk: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <Package Version="5"> 4 | <Name Value="lspserver"/> 5 | <Type Value="RunAndDesignTime"/> 6 | <CompilerOptions> 7 | <Version Value="11"/> 8 | <SearchPaths> 9 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 10 | </SearchPaths> 11 | </CompilerOptions> 12 | <Files> 13 | <Item> 14 | <Filename Value="PasLS.General.pas"/> 15 | <UnitName Value="PasLS.General"/> 16 | </Item> 17 | <Item> 18 | <Filename Value="PasLS.References.pas"/> 19 | <UnitName Value="PasLS.References"/> 20 | </Item> 21 | <Item> 22 | <Filename Value="PasLS.Diagnostics.pas"/> 23 | <UnitName Value="PasLS.Diagnostics"/> 24 | </Item> 25 | <Item> 26 | <Filename Value="PasLS.GotoDeclaration.pas"/> 27 | <UnitName Value="PasLS.GotoDeclaration"/> 28 | </Item> 29 | <Item> 30 | <Filename Value="PasLS.GotoDefinition.pas"/> 31 | <UnitName Value="PasLS.GotoDefinition"/> 32 | </Item> 33 | <Item> 34 | <Filename Value="PasLS.GotoImplementation.pas"/> 35 | <UnitName Value="PasLS.GotoImplementation"/> 36 | </Item> 37 | <Item> 38 | <Filename Value="PasLS.Completion.pas"/> 39 | <UnitName Value="PasLS.Completion"/> 40 | </Item> 41 | <Item> 42 | <Filename Value="PasLS.SignatureHelp.pas"/> 43 | <UnitName Value="PasLS.SignatureHelp"/> 44 | </Item> 45 | <Item> 46 | <Filename Value="PasLS.Synchronization.pas"/> 47 | <UnitName Value="PasLS.Synchronization"/> 48 | </Item> 49 | <Item> 50 | <Filename Value="PasLS.AllCommands.pas"/> 51 | <UnitName Value="PasLS.AllCommands"/> 52 | </Item> 53 | <Item> 54 | <Filename Value="PasLS.CodeAction.pas"/> 55 | <UnitName Value="PasLS.CodeAction"/> 56 | </Item> 57 | <Item> 58 | <Filename Value="PasLS.DocumentHighlight.pas"/> 59 | <UnitName Value="PasLS.DocumentHighlight"/> 60 | </Item> 61 | <Item> 62 | <Filename Value="PasLS.Hover.pas"/> 63 | <UnitName Value="PasLS.Hover"/> 64 | </Item> 65 | <Item> 66 | <Filename Value="PasLS.InlayHint.pas"/> 67 | <UnitName Value="PasLS.InlayHint"/> 68 | </Item> 69 | <Item> 70 | <Filename Value="PasLS.Workspace.pas"/> 71 | <UnitName Value="PasLS.Workspace"/> 72 | </Item> 73 | <Item> 74 | <Filename Value="PasLS.ApplyEdit.pas"/> 75 | <UnitName Value="PasLS.ApplyEdit"/> 76 | </Item> 77 | <Item> 78 | <Filename Value="PasLS.RemoveEmptyMethods.pas"/> 79 | <UnitName Value="PasLS.RemoveEmptyMethods"/> 80 | </Item> 81 | <Item> 82 | <Filename Value="PasLS.Command.CompleteCode.pas"/> 83 | <UnitName Value="PasLS.Command.CompleteCode"/> 84 | </Item> 85 | <Item> 86 | <Filename Value="PasLS.Command.FormatCode.pas"/> 87 | <UnitName Value="PasLS.Command.FormatCode"/> 88 | </Item> 89 | <Item> 90 | <Filename Value="PasLS.Command.InvertAssignment.pas"/> 91 | <UnitName Value="PasLS.Command.InvertAssignment"/> 92 | </Item> 93 | <Item> 94 | <Filename Value="PasLS.Command.RemoveEmptyMethods.pas"/> 95 | <UnitName Value="PasLS.Command.RemoveEmptyMethods"/> 96 | </Item> 97 | <Item> 98 | <Filename Value="PasLS.DocumentSymbol.pas"/> 99 | <UnitName Value="PasLS.DocumentSymbol"/> 100 | </Item> 101 | <Item> 102 | <Filename Value="PasLS.Commands.pas"/> 103 | <UnitName Value="PasLS.Commands"/> 104 | </Item> 105 | <Item> 106 | <Filename Value="PasLS.Formatter.pas"/> 107 | <UnitName Value="PasLS.Formatter"/> 108 | </Item> 109 | <Item> 110 | <Filename Value="PasLS.ExecuteCommand.pas"/> 111 | <UnitName Value="PasLS.ExecuteCommand"/> 112 | </Item> 113 | <Item> 114 | <Filename Value="PasLS.CodeUtils.pas"/> 115 | <UnitName Value="PasLS.CodeUtils"/> 116 | </Item> 117 | <Item> 118 | <Filename Value="PasLS.InvertAssign.pas"/> 119 | <UnitName Value="PasLS.InvertAssign"/> 120 | </Item> 121 | <Item> 122 | <Filename Value="PasLS.LazConfig.pas"/> 123 | <UnitName Value="PasLS.LazConfig"/> 124 | </Item> 125 | <Item> 126 | <Filename Value="PasLS.Parser.pas"/> 127 | <UnitName Value="PasLS.Parser"/> 128 | </Item> 129 | <Item> 130 | <Filename Value="PasLS.Symbols.pas"/> 131 | <UnitName Value="PasLS.Symbols"/> 132 | </Item> 133 | <Item> 134 | <Filename Value="PasLS.CheckInactiveRegions.pas"/> 135 | <UnitName Value="PasLS.CheckInactiveRegions"/> 136 | </Item> 137 | <Item> 138 | <Filename Value="PasLS.InactiveRegions.pas"/> 139 | <UnitName Value="PasLS.InactiveRegions"/> 140 | </Item> 141 | </Files> 142 | <RequiredPkgs> 143 | <Item> 144 | <PackageName Value="lspprotocol"/> 145 | </Item> 146 | <Item> 147 | <PackageName Value="jcfbase"/> 148 | </Item> 149 | <Item> 150 | <PackageName Value="CodeTools"/> 151 | </Item> 152 | <Item> 153 | <PackageName Value="FCL"/> 154 | </Item> 155 | </RequiredPkgs> 156 | <UsageOptions> 157 | <UnitPath Value="$(PkgOutDir)"/> 158 | </UsageOptions> 159 | <PublishOptions> 160 | <Version Value="2"/> 161 | <UseFileFilters Value="True"/> 162 | </PublishOptions> 163 | </Package> 164 | </CONFIG> 165 | -------------------------------------------------------------------------------- /src/serverprotocol/lspserver.pas: -------------------------------------------------------------------------------- 1 | { This file was automatically created by Lazarus. Do not edit! 2 | This source is only used to compile and install the package. 3 | } 4 | 5 | unit lspserver; 6 | 7 | {$warn 5023 off : no warning about unused units} 8 | interface 9 | 10 | uses 11 | PasLS.General, PasLS.References, PasLS.Diagnostics, PasLS.GotoDeclaration, 12 | PasLS.GotoDefinition, PasLS.GotoImplementation, PasLS.Completion, 13 | PasLS.SignatureHelp, PasLS.Synchronization, PasLS.AllCommands, 14 | PasLS.CodeAction, PasLS.DocumentHighlight, PasLS.Hover, PasLS.InlayHint, 15 | PasLS.Workspace, PasLS.ApplyEdit, PasLS.RemoveEmptyMethods, 16 | PasLS.Command.CompleteCode, PasLS.Command.FormatCode, 17 | PasLS.Command.InvertAssignment, PasLS.Command.RemoveEmptyMethods, 18 | PasLS.DocumentSymbol, PasLS.Commands, PasLS.Formatter, PasLS.ExecuteCommand, 19 | PasLS.CodeUtils, PasLS.InvertAssign, PasLS.LazConfig, PasLS.Parser, 20 | PasLS.Symbols, PasLS.CheckInactiveRegions, PasLS.InactiveRegions, 21 | LazarusPackageIntf; 22 | 23 | implementation 24 | 25 | procedure Register; 26 | begin 27 | end; 28 | 29 | initialization 30 | RegisterPackage('lspserver', @Register); 31 | end. 32 | -------------------------------------------------------------------------------- /src/socketserver/PasLSSock.Config.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // Socket-based protocol server - configuration options 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLSSock.Config; 21 | 22 | {$mode ObjFPC}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | Classes, SysUtils, Inifiles; 28 | 29 | Const 30 | DefaultSocketUnix = ''; 31 | DefaultSocketPort = 9898; 32 | DefaultSingleConnect = False; 33 | DefaultThreaded = False; 34 | DefaultLogFile = ''; 35 | DefaultCompiler = 'fpc'; 36 | DefaultLazarusDir = ''; 37 | DefaultFPCDir = ''; 38 | DefaultTargetOS = {$i %FPCTARGETOS%}; 39 | DefaultTargetCPU = {$i %FPCTARGETCPU%}; 40 | 41 | Type 42 | { TLSPSocketServerConfig } 43 | 44 | TLSPSocketServerConfig = Class(TObject) 45 | private 46 | FCompiler: string; 47 | FFPCDir: string; 48 | FLazarusDir: string; 49 | FLogFile: String; 50 | FPort: Word; 51 | FSingleConnect: Boolean; 52 | FTargetCPU: string; 53 | FTargetOS: string; 54 | FThreaded: Boolean; 55 | FUnix: String; 56 | Public 57 | Constructor Create; virtual; 58 | Procedure Reset; virtual; 59 | class Function DefaultConfigFile : String; 60 | Procedure LoadFromFile(const aFileName : String); 61 | Procedure SaveToFile(const aFileName : String); 62 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual; 63 | Procedure SaveToIni(aIni : TCustomIniFile); virtual; 64 | Public 65 | Property Port : Word Read FPort Write FPort; 66 | Property Unix : String Read FUnix Write FUnix; 67 | Property SingleConnect : Boolean Read FSingleConnect Write FSingleConnect; 68 | Property Threaded : Boolean Read FThreaded Write FThreaded; 69 | Property LogFile : String Read FLogFile Write FLogFile; 70 | property Compiler : string read FCompiler write FCompiler; 71 | property FPCDir : string Read FFPCDir Write FFPCDir; 72 | property LazarusDir : string read FLazarusDir write FLazarusDir; 73 | property TargetOS : string read FTargetOS write FTargetOS; 74 | property TargetCPU : string read FTargetCPU write FTargetCPU; 75 | end; 76 | 77 | 78 | implementation 79 | 80 | Const 81 | SServer = 'Server'; 82 | KeyPort = 'Port'; 83 | KeyUnix = 'Unix'; 84 | KeySingleConnect = 'SingleConnect'; 85 | KeyThreaded = 'Threaded'; 86 | KeyLogFile = 'LogFile'; 87 | 88 | SCodeTools = 'CodeTools'; 89 | KeyCompiler = 'Compiler'; 90 | KeyFPCDir = 'FPCDir'; 91 | KeyLazarusDir = 'LazarusDir'; 92 | KeyTargetCPU = 'TargetCPU'; 93 | KeyTargetOS = 'TargetOS'; 94 | 95 | { TLSPSocketServerConfig } 96 | 97 | constructor TLSPSocketServerConfig.Create; 98 | begin 99 | Reset; 100 | end; 101 | 102 | procedure TLSPSocketServerConfig.Reset; 103 | begin 104 | FPort:=DefaultSocketPort; 105 | FUnix:=DefaultSocketUnix; 106 | FSingleConnect:=DefaultSingleConnect; 107 | FThreaded:=DefaultThreaded; 108 | LogFile:=DefaultLogFile; 109 | Compiler:=DefaultCompiler; 110 | FPCDir:=DefaultFPCDir; 111 | LazarusDir:=DefaultLazarusDir; 112 | TargetCPU:=DefaultTargetCPU; 113 | TargetOS:=DefaultTargetOS; 114 | end; 115 | 116 | class function TLSPSocketServerConfig.DefaultConfigFile: String; 117 | begin 118 | {$IFDEF UNIX} 119 | Result:='/etc/paslssock.cfg'; 120 | {$ELSE} 121 | Result:=ChangeFileExt(ParamStr(0),'.ini'); 122 | {$ENDIF} 123 | end; 124 | 125 | procedure TLSPSocketServerConfig.LoadFromFile(const aFileName: String); 126 | 127 | Var 128 | Ini : TCustomIniFile; 129 | 130 | begin 131 | Ini:=TMemIniFile.Create(aFileName); 132 | try 133 | LoadFromIni(Ini); 134 | finally 135 | Ini.Free; 136 | end; 137 | end; 138 | 139 | procedure TLSPSocketServerConfig.SaveToFile(const aFileName: String); 140 | Var 141 | Ini : TCustomIniFile; 142 | 143 | begin 144 | Ini:=TMemIniFile.Create(aFileName); 145 | try 146 | SaveToIni(Ini); 147 | Ini.UpdateFile; 148 | finally 149 | Ini.Free; 150 | end; 151 | end; 152 | 153 | procedure TLSPSocketServerConfig.LoadFromIni(aIni: TCustomIniFile); 154 | begin 155 | With aIni do 156 | begin 157 | FPort:=ReadInteger(SServer,KeyPort,FPort); 158 | FUnix:=ReadString(SServer,KeyUnix,FUnix); 159 | FSingleConnect:=ReadBool(SServer,KeySingleConnect,SingleConnect); 160 | FThreaded:=ReadBool(SServer,KeyThreaded,Threaded); 161 | FLogFile:=ReadString(SServer,KeyLogFile,LogFile); 162 | Compiler:=ReadString(SCodeTools,KeyCompiler,Compiler); 163 | FPCDir:=ReadString(SCodetools,KeyFPCDir,FPCDir); 164 | LazarusDir:=ReadString(SCodetools,KeyLazarusDir,LazarusDir); 165 | TargetCPU:=ReadString(SCodetools,KeyTargetCPU,TargetCPU); 166 | TargetOS:=ReadString(SCodetools,KeyTargetOS,TargetOS); 167 | end; 168 | end; 169 | 170 | procedure TLSPSocketServerConfig.SaveToIni(aIni: TCustomIniFile); 171 | begin 172 | With aIni do 173 | begin 174 | WriteInteger(SServer,KeyPort,FPort); 175 | WriteString(SServer,KeyUnix,FUnix); 176 | WriteBool(SServer,KeySingleConnect,SingleConnect); 177 | WriteBool(SServer,KeyThreaded,Threaded); 178 | WriteString(SServer,KeyLogFile,LogFile); 179 | WriteString(SCodeTools,KeyCompiler,Compiler); 180 | WriteString(SCodetools,KeyFPCDir,FPCDir); 181 | WriteString(SCodetools,KeyLazarusDir,LazarusDir); 182 | WriteString(SCodetools,KeyTargetCPU,TargetCPU); 183 | WriteString(SCodetools,KeyTargetOS,TargetOS); 184 | end; 185 | end; 186 | 187 | 188 | end. 189 | 190 | -------------------------------------------------------------------------------- /src/socketserver/paslssock.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <General> 6 | <Flags> 7 | <SaveOnlyProjectUnits Value="True"/> 8 | <MainUnitHasCreateFormStatements Value="False"/> 9 | <MainUnitHasTitleStatement Value="False"/> 10 | <MainUnitHasScaledStatement Value="False"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <Title Value="Pascal LSP socket server application"/> 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes> 18 | <Item Name="Default" Default="True"/> 19 | </BuildModes> 20 | <PublishOptions> 21 | <Version Value="2"/> 22 | <UseFileFilters Value="True"/> 23 | </PublishOptions> 24 | <RunParams> 25 | <FormatVersion Value="2"/> 26 | </RunParams> 27 | <RequiredPackages> 28 | <Item> 29 | <PackageName Value="lspserver"/> 30 | </Item> 31 | <Item> 32 | <PackageName Value="lspprotocol"/> 33 | </Item> 34 | </RequiredPackages> 35 | <Units> 36 | <Unit> 37 | <Filename Value="paslssock.lpr"/> 38 | <IsPartOfProject Value="True"/> 39 | </Unit> 40 | <Unit> 41 | <Filename Value="PasLSSock.Config.pas"/> 42 | <IsPartOfProject Value="True"/> 43 | </Unit> 44 | </Units> 45 | </ProjectOptions> 46 | <CompilerOptions> 47 | <Version Value="11"/> 48 | <Target> 49 | <Filename Value="paslssock"/> 50 | </Target> 51 | <SearchPaths> 52 | <IncludeFiles Value="$(ProjOutDir)"/> 53 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 54 | </SearchPaths> 55 | <Linking> 56 | <Debugging> 57 | <DebugInfoType Value="dsDwarf3"/> 58 | <UseHeaptrc Value="True"/> 59 | </Debugging> 60 | </Linking> 61 | </CompilerOptions> 62 | <Debugging> 63 | <Exceptions> 64 | <Item> 65 | <Name Value="EAbort"/> 66 | </Item> 67 | <Item> 68 | <Name Value="ECodetoolError"/> 69 | </Item> 70 | <Item> 71 | <Name Value="EFOpenError"/> 72 | </Item> 73 | <Item> 74 | <Name Value="ECodeToolUnitNotFound"/> 75 | </Item> 76 | </Exceptions> 77 | </Debugging> 78 | </CONFIG> 79 | -------------------------------------------------------------------------------- /src/socketserver/paslssock.lpr: -------------------------------------------------------------------------------- 1 | program paslssock; 2 | 3 | // Socket-based Pascal Language Server 4 | // Copyright 2023 Michael Van Canneyt 5 | 6 | // This file is part of Pascal Language Server. 7 | 8 | // Pascal Language Server is free software: you can redistribute it 9 | // and/or modify it under the terms of the GNU General Public License 10 | // as published by the Free Software Foundation, either version 3 of 11 | // the License, or (at your option) any later version. 12 | 13 | // Pascal Language Server is distributed in the hope that it will be 14 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 15 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | // GNU General Public License for more details. 17 | 18 | // You should have received a copy of the GNU General Public License 19 | // along with Pascal Language Server. If not, see 20 | // <https://www.gnu.org/licenses/>. 21 | 22 | 23 | {$mode objfpc}{$H+} 24 | {$modeswitch advancedrecords} 25 | 26 | uses 27 | {$IFDEF UNIX} 28 | cthreads, cwstring, 29 | {$ENDIF} 30 | LazLogger, 31 | Classes, SysUtils, CustApp, IniFiles, PasLS.AllCommands, LSP.Messages, 32 | LSP.Base, PasLS.Settings, PasLSSock.Config, PasLS.SocketDispatcher; 33 | 34 | type 35 | 36 | { TPasLSPSocketServerApp } 37 | 38 | TPasLSPSocketServerApp = class(TCustomApplication) 39 | Private 40 | FConfig : TLSPSocketServerConfig; 41 | procedure ConfigureLSP; 42 | procedure DoMessageLog(sender: TObject; const Msg: UTF8String); 43 | function ParseOptions: Boolean; 44 | protected 45 | procedure DoRun; override; 46 | public 47 | constructor Create(TheOwner: TComponent); override; 48 | destructor Destroy; override; 49 | procedure Usage(const aError: String); virtual; 50 | end; 51 | 52 | 53 | { TPasLSPSocketServerApp } 54 | 55 | function TPasLSPSocketServerApp.ParseOptions : Boolean; 56 | 57 | var 58 | FN : String; 59 | begin 60 | Result:=False; 61 | FN:=GetOptionValue('c','config'); 62 | if FN='' then 63 | FN:=TLSPSocketServerConfig.DefaultConfigFile; 64 | FConfig.LoadFromFile(FN); 65 | {$IFDEF UNIX} 66 | if HasOption('u','unix') then 67 | FConfig.Unix:=GetOptionValue('u','unix'); 68 | {$ENDIF} 69 | if HasOption('p','port') then 70 | FConfig.Port:=StrToInt(GetOptionValue('p','port')); 71 | if HasOption('l','log') then 72 | FConfig.LogFile:=GetOptionValue('l','log'); 73 | if HasOption('t','threaded') then 74 | FConfig.Threaded:=True; 75 | if HasOption('s','single-connect') then 76 | FConfig.SingleConnect:=True; 77 | Result:=True; 78 | end; 79 | 80 | procedure TPasLSPSocketServerApp.ConfigureLSP; 81 | 82 | begin 83 | TLSPContext.LogFile:=FConfig.LogFile; 84 | With EnvironmentSettings do 85 | begin 86 | pp:=FConfig.Compiler; 87 | fpcDir:=FConfig.FPCDir; 88 | lazarusDir:=FConfig.LazarusDir; 89 | fpcTarget:=FConfig.TargetOS; 90 | fpcTargetCPU:=FConfig.TargetCPU; 91 | end; 92 | TMessageTransport.OnLog:=@DoMessageLog; 93 | end; 94 | 95 | procedure TPasLSPSocketServerApp.DoMessageLog(sender: TObject; 96 | const Msg: UTF8String); 97 | begin 98 | TLSPContext.Log(Msg); 99 | if Sender<>Nil then; 100 | end; 101 | 102 | procedure TPasLSPSocketServerApp.DoRun; 103 | 104 | Const 105 | ShortOpts = 'hp:u:c:tsl:'; 106 | LongOpts : array of string = ('help','port','unix','config','threaded','single-connect','log:'); 107 | 108 | 109 | var 110 | ErrorMsg: String; 111 | Disp : TLSPServerSocketDispatcher; 112 | 113 | begin 114 | Terminate; 115 | RegisterAllCommands; 116 | // quick check parameters 117 | ErrorMsg:=CheckOptions(ShortOpts,LongOpts); 118 | if (ErrorMsg<>'') or HasOption('h','help') then 119 | begin 120 | Usage(ErrorMsg); 121 | Exit; 122 | end; 123 | if not ParseOptions then 124 | exit; 125 | ConfigureLSP; 126 | if FConfig.Port>0 then 127 | Disp:=TLSPServerTCPSocketDispatcher.Create(FConfig.Port) 128 | else 129 | Disp:=TLSPServerUnixSocketDispatcher.Create(FConfig.Unix); 130 | Try 131 | Disp.SingleConnect:=FConfig.SingleConnect; 132 | Disp.InitSocket; 133 | Disp.RunLoop; 134 | finally 135 | Disp.Free; 136 | end; 137 | end; 138 | 139 | constructor TPasLSPSocketServerApp.Create(TheOwner: TComponent); 140 | begin 141 | inherited Create(TheOwner); 142 | StopOnException:=True; 143 | FConfig:=TLSPSocketServerConfig.Create; 144 | end; 145 | 146 | destructor TPasLSPSocketServerApp.Destroy; 147 | begin 148 | FConfig.Free; 149 | inherited Destroy; 150 | end; 151 | 152 | procedure TPasLSPSocketServerApp.Usage(const aError : String); 153 | begin 154 | if aError<>'' then 155 | Writeln('Error : ',aError); 156 | Writeln('Usage: ', ExeName, ' [options]'); 157 | Writeln('Where options is one or more of:'); 158 | Writeln('-h --help This help message'); 159 | Writeln('-c --config=FILE Read configuration from file FILE. Default is to read from ',TLSPSocketServerConfig.DefaultConfigFile); 160 | Writeln('-l --log=FILE Set log file in which to write all log messages'); 161 | Writeln('-p --port=NNN Listen on port NNN'); 162 | Writeln('-s --single-connect Handle one connection and then exit'); 163 | Writeln('-t --threaded Use threading for connections.'); 164 | Writeln('-u --unix=FILE Listen on unix socket FILE (only on unix-like systems)'); 165 | Writeln('Only one of -p or -u may be specified, if none is specified then the default is to listen on port 9898'); 166 | ExitCode:=Ord(aError<>'') 167 | end; 168 | 169 | var 170 | Application: TPasLSPSocketServerApp; 171 | Buffer: Array[1..100*1024] of byte; 172 | 173 | begin 174 | Close(Output); 175 | Assign(Output,GetTempDir(false)+'paslssock-out.log'); 176 | SetTextBuf(Output,Buffer,SizeOf(Buffer)); 177 | Rewrite(output); 178 | Application:=TPasLSPSocketServerApp.Create(nil); 179 | Application.Title:='Pascal LSP socket server application'; 180 | Application.Run; 181 | Application.Free; 182 | end. 183 | 184 | -------------------------------------------------------------------------------- /src/standard/PasLS.LSConfig.pas: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2023 Michael Van Canneyt 3 | 4 | // Socket-based protocol server - configuration options 5 | 6 | // Pascal Language Server is free software: you can redistribute it 7 | // and/or modify it under the terms of the GNU General Public License 8 | // as published by the Free Software Foundation, either version 3 of 9 | // the License, or (at your option) any later version. 10 | 11 | // Pascal Language Server is distributed in the hope that it will be 12 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 13 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | // GNU General Public License for more details. 15 | 16 | // You should have received a copy of the GNU General Public License 17 | // along with Pascal Language Server. If not, see 18 | // <https://www.gnu.org/licenses/>. 19 | 20 | unit PasLS.LSConfig; 21 | 22 | {$mode ObjFPC}{$H+} 23 | 24 | interface 25 | 26 | uses 27 | Classes, SysUtils, Inifiles; 28 | 29 | Const 30 | DefaultLogFile = ''; 31 | DefaultCompiler = 'fpc'; 32 | DefaultLazarusDir = ''; 33 | DefaultFPCDir = ''; 34 | DefaultTargetOS = {$i %FPCTARGETOS%}; 35 | DefaultTargetCPU = {$i %FPCTARGETCPU%}; 36 | 37 | Type 38 | { TLSPServerConfig } 39 | 40 | TLSPServerConfig = Class(TObject) 41 | private 42 | FCompiler: string; 43 | FFPCDir: string; 44 | FLazarusDir: string; 45 | FLogFile: String; 46 | FTargetCPU: string; 47 | FTargetOS: string; 48 | Public 49 | Constructor Create; virtual; 50 | Procedure Reset; virtual; 51 | class Function DefaultConfigFile : String; 52 | Procedure LoadFromFile(const aFileName : String); 53 | Procedure SaveToFile(const aFileName : String); 54 | Procedure LoadFromIni(aIni : TCustomIniFile); virtual; 55 | Procedure SaveToIni(aIni : TCustomIniFile); virtual; 56 | Public 57 | Property LogFile : String Read FLogFile Write FLogFile; 58 | property Compiler : string read FCompiler write FCompiler; 59 | property FPCDir : string Read FFPCDir Write FFPCDir; 60 | property LazarusDir : string read FLazarusDir write FLazarusDir; 61 | property TargetOS : string read FTargetOS write FTargetOS; 62 | property TargetCPU : string read FTargetCPU write FTargetCPU; 63 | end; 64 | 65 | 66 | implementation 67 | 68 | Const 69 | SServer = 'Server'; 70 | KeyLogFile = 'LogFile'; 71 | 72 | SCodeTools = 'CodeTools'; 73 | KeyCompiler = 'Compiler'; 74 | KeyFPCDir = 'FPCDir'; 75 | KeyLazarusDir = 'LazarusDir'; 76 | KeyTargetCPU = 'TargetCPU'; 77 | KeyTargetOS = 'TargetOS'; 78 | 79 | { TLSPServerConfig } 80 | 81 | constructor TLSPServerConfig.Create; 82 | begin 83 | Reset; 84 | end; 85 | 86 | procedure TLSPServerConfig.Reset; 87 | begin 88 | LogFile:=DefaultLogFile; 89 | Compiler:=DefaultCompiler; 90 | FPCDir:=DefaultFPCDir; 91 | LazarusDir:=DefaultLazarusDir; 92 | TargetCPU:=DefaultTargetCPU; 93 | TargetOS:=DefaultTargetOS; 94 | end; 95 | 96 | class function TLSPServerConfig.DefaultConfigFile: String; 97 | begin 98 | {$IFDEF UNIX} 99 | Result:='/etc/pasls.cfg'; 100 | {$ELSE} 101 | Result:=ChangeFileExt(ParamStr(0),'.ini'); 102 | {$ENDIF} 103 | end; 104 | 105 | procedure TLSPServerConfig.LoadFromFile(const aFileName: String); 106 | 107 | Var 108 | Ini : TCustomIniFile; 109 | 110 | begin 111 | Ini:=TMemIniFile.Create(aFileName); 112 | try 113 | LoadFromIni(Ini); 114 | finally 115 | Ini.Free; 116 | end; 117 | end; 118 | 119 | procedure TLSPServerConfig.SaveToFile(const aFileName: String); 120 | Var 121 | Ini : TCustomIniFile; 122 | 123 | begin 124 | Ini:=TMemIniFile.Create(aFileName); 125 | try 126 | SaveToIni(Ini); 127 | Ini.UpdateFile; 128 | finally 129 | Ini.Free; 130 | end; 131 | end; 132 | 133 | procedure TLSPServerConfig.LoadFromIni(aIni: TCustomIniFile); 134 | begin 135 | With aIni do 136 | begin 137 | FLogFile:=ReadString(SServer,KeyLogFile,LogFile); 138 | Compiler:=ReadString(SCodeTools,KeyCompiler,Compiler); 139 | FPCDir:=ReadString(SCodetools,KeyFPCDir,FPCDir); 140 | LazarusDir:=ReadString(SCodetools,KeyLazarusDir,LazarusDir); 141 | TargetCPU:=ReadString(SCodetools,KeyTargetCPU,TargetCPU); 142 | TargetOS:=ReadString(SCodetools,KeyTargetOS,TargetOS); 143 | end; 144 | end; 145 | 146 | procedure TLSPServerConfig.SaveToIni(aIni: TCustomIniFile); 147 | begin 148 | With aIni do 149 | begin 150 | WriteString(SServer,KeyLogFile,LogFile); 151 | WriteString(SCodeTools,KeyCompiler,Compiler); 152 | WriteString(SCodetools,KeyFPCDir,FPCDir); 153 | WriteString(SCodetools,KeyLazarusDir,LazarusDir); 154 | WriteString(SCodetools,KeyTargetCPU,TargetCPU); 155 | WriteString(SCodetools,KeyTargetOS,TargetOS); 156 | end; 157 | end; 158 | 159 | 160 | end. 161 | 162 | -------------------------------------------------------------------------------- /src/standard/pasls.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <General> 6 | <Flags> 7 | <MainUnitHasCreateFormStatements Value="False"/> 8 | <MainUnitHasTitleStatement Value="False"/> 9 | <MainUnitHasScaledStatement Value="False"/> 10 | <CompatibilityMode Value="True"/> 11 | </Flags> 12 | <SessionStorage Value="InProjectDir"/> 13 | <Title Value="pasls"/> 14 | <UseAppBundle Value="False"/> 15 | <ResourceType Value="res"/> 16 | </General> 17 | <BuildModes Count="2"> 18 | <Item1 Name="Debug" Default="True"/> 19 | <Item2 Name="Release"> 20 | <CompilerOptions> 21 | <Version Value="11"/> 22 | <SearchPaths> 23 | <IncludeFiles Value="$(ProjOutDir)"/> 24 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 25 | </SearchPaths> 26 | <CodeGeneration> 27 | <SmartLinkUnit Value="True"/> 28 | <Optimizations> 29 | <OptimizationLevel Value="3"/> 30 | </Optimizations> 31 | </CodeGeneration> 32 | <Linking> 33 | <Debugging> 34 | <GenerateDebugInfo Value="False"/> 35 | </Debugging> 36 | <LinkSmart Value="True"/> 37 | </Linking> 38 | </CompilerOptions> 39 | </Item2> 40 | </BuildModes> 41 | <PublishOptions> 42 | <Version Value="2"/> 43 | <UseFileFilters Value="True"/> 44 | </PublishOptions> 45 | <RunParams> 46 | <FormatVersion Value="2"/> 47 | </RunParams> 48 | <RequiredPackages Count="5"> 49 | <Item1> 50 | <PackageName Value="lspserver"/> 51 | </Item1> 52 | <Item2> 53 | <PackageName Value="lspprotocol"/> 54 | </Item2> 55 | <Item3> 56 | <PackageName Value="CodeTools"/> 57 | </Item3> 58 | <Item4> 59 | <PackageName Value="WebLaz"/> 60 | </Item4> 61 | <Item5> 62 | <PackageName Value="FCL"/> 63 | </Item5> 64 | </RequiredPackages> 65 | <Units Count="2"> 66 | <Unit0> 67 | <Filename Value="pasls.lpr"/> 68 | <IsPartOfProject Value="True"/> 69 | </Unit0> 70 | <Unit1> 71 | <Filename Value="PasLS.LSConfig.pas"/> 72 | <IsPartOfProject Value="True"/> 73 | </Unit1> 74 | </Units> 75 | </ProjectOptions> 76 | <CompilerOptions> 77 | <Version Value="11"/> 78 | <Target> 79 | <Filename Value="pasls"/> 80 | </Target> 81 | <SearchPaths> 82 | <IncludeFiles Value="$(ProjOutDir)"/> 83 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 84 | </SearchPaths> 85 | <Parsing> 86 | <SyntaxOptions> 87 | <IncludeAssertionCode Value="True"/> 88 | </SyntaxOptions> 89 | </Parsing> 90 | <CodeGeneration> 91 | <Checks> 92 | <IOChecks Value="True"/> 93 | <RangeChecks Value="True"/> 94 | <OverflowChecks Value="True"/> 95 | <StackChecks Value="True"/> 96 | </Checks> 97 | <VerifyObjMethodCallValidity Value="True"/> 98 | </CodeGeneration> 99 | <Other> 100 | <Verbosity> 101 | <ShowNotes Value="False"/> 102 | <ShowHints Value="False"/> 103 | </Verbosity> 104 | <CustomOptions Value="-dx86_64 -gw -godwarfcpp"/> 105 | </Other> 106 | </CompilerOptions> 107 | </CONFIG> 108 | -------------------------------------------------------------------------------- /src/standard/pasls.lpr: -------------------------------------------------------------------------------- 1 | // Pascal Language Server 2 | // Copyright 2020 Arjan Adriaanse 3 | // Copyright 2020 Ryan Joseph 4 | 5 | // This file is part of Pascal Language Server. 6 | 7 | // Pascal Language Server is free software: you can redistribute it 8 | // and/or modify it under the terms of the GNU General Public License 9 | // as published by the Free Software Foundation, either version 3 of 10 | // the License, or (at your option) any later version. 11 | 12 | // Pascal Language Server is distributed in the hope that it will be 13 | // useful, but WITHOUT ANY WARRANTY; without even the implied warranty 14 | // of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | // GNU General Public License for more details. 16 | 17 | // You should have received a copy of the GNU General Public License 18 | // along with Pascal Language Server. If not, see 19 | // <https://www.gnu.org/licenses/>. 20 | 21 | program pasls; 22 | 23 | {$mode objfpc}{$H+} 24 | 25 | uses 26 | { RTL } 27 | 28 | SysUtils, Classes, FPJson, JSONParser, JSONScanner, 29 | { Protocol } 30 | PasLS.AllCommands, PasLS.Settings, 31 | LSP.Base, LSP.Basic, PasLS.TextLoop, PasLS.LSConfig; 32 | 33 | Type 34 | 35 | { TLSPLogContext } 36 | 37 | TLSPLogContext = Class(TLSPContext) 38 | Public 39 | procedure DoTransportLog(sender : TObject; Const Msg : UTF8String); 40 | 41 | end; 42 | 43 | Function ExecuteCommandLineMessages(aContext : TLSPContext) : Boolean; 44 | 45 | var 46 | i: integer; 47 | method, path : String; 48 | 49 | begin 50 | Result:=True; 51 | if ParamCount=0 then 52 | exit; 53 | if (ParamCount div 2)= 1 then 54 | begin 55 | writeln('Invalid parameter count of '+ParamCount.ToString+' (must be pairs of 2)'); 56 | Exit(false); 57 | end; 58 | TLSPContext.Log('Command-line Message loop'); 59 | I:=1; 60 | while i <= ParamCount do 61 | begin 62 | method := ParamStr(i); 63 | path := ExpandFileName(ParamStr(i + 1)); 64 | if not FileExists(path) then 65 | begin 66 | writeln('Command path "',path,'" can''t be found'); 67 | exit(false) 68 | end; 69 | DebugSendMessage(output,aContext, method, GetFileAsString(path)); 70 | Inc(i, 2); 71 | end; 72 | end; 73 | 74 | Procedure ConfigEnvironment(aConfig : TLSPServerConfig); 75 | 76 | begin 77 | With EnvironmentSettings do 78 | begin 79 | pp:=aConfig.Compiler; 80 | fpcDir:=aConfig.FPCDir; 81 | lazarusDir:=aConfig.LazarusDir; 82 | fpcTarget:=aConfig.TargetOS; 83 | fpcTargetCPU:=aConfig.TargetCPU; 84 | end; 85 | end; 86 | 87 | var 88 | aTransport: TLSPTextTransport; 89 | aContext: TLSPLogContext; 90 | aDisp: TLSPLocalDispatcher; 91 | aCfg: TLSPServerConfig; 92 | 93 | { TLSPLogContext } 94 | 95 | procedure TLSPLogContext.DoTransportLog(sender: TObject; const Msg: UTF8String); 96 | begin 97 | Log('Transport log: '+Msg); 98 | end; 99 | 100 | 101 | begin 102 | // Show help for the server 103 | if ParamStr(1) = '-h' then 104 | begin 105 | writeln('Pascal Language Server [',{$INCLUDE %DATE%},']'); 106 | Halt; 107 | end; 108 | aContext := nil; 109 | aCfg := TLSPServerConfig.Create; 110 | try 111 | RegisterAllCommands; 112 | aCfg.LoadFromFile(aCfg.DefaultConfigFile); 113 | if aCfg.LogFile<>'' then 114 | TLSPContext.LogFile := aCfg.LogFile; 115 | ConfigEnvironment(aCfg); 116 | SetupTextLoop(Input,Output,StdErr); 117 | aTransport:=TLSPTextTransport.Create(@Output,@StdErr); 118 | aDisp:=TLSPLocalDispatcher.Create(aTransport,True); 119 | aContext:=TLSPLogContext.Create(aTransport,aDisp,True); 120 | aTransport.OnLog := @aContext.DoTransportLog; 121 | if not ExecuteCommandLineMessages(aContext) then 122 | exit; 123 | RunMessageLoop(Input,Output,StdErr,aContext); 124 | Finally 125 | aContext.Free; 126 | aCfg.Free; 127 | end; 128 | end. 129 | -------------------------------------------------------------------------------- /src/tests/Tests.Basic.pas: -------------------------------------------------------------------------------- 1 | unit Tests.Basic; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | interface 6 | 7 | uses 8 | Classes, SysUtils, fpcunit, testutils, testregistry, 9 | LSP.Basic; 10 | 11 | type 12 | 13 | { TTestRange } 14 | 15 | TTestRange= class(TTestCase) 16 | private 17 | FRange: TRange; 18 | procedure SetRange(AValue: TRange); 19 | protected 20 | procedure SetUp; override; 21 | procedure TearDown; override; 22 | Procedure CheckRange(Msg : string; aStartLine,aStartChar,aEndLine,aEndChar : Integer); 23 | // Created in startup, will be freed in teardown. 24 | Property Range : TRange Read FRange Write SetRange; 25 | Public 26 | class Procedure CheckRange(Msg : string; aRange: TRange; aStartLine,aStartChar,aEndLine,aEndChar : Integer); 27 | published 28 | procedure TestHookUp; 29 | procedure TestAssign; 30 | procedure TestConstructorLen; 31 | procedure TestConstructorAllPos; 32 | procedure TestSetRangeLen; 33 | Procedure TestSetRangeAllPos; 34 | Procedure TestToString; 35 | end; 36 | 37 | implementation 38 | 39 | procedure TTestRange.TestHookUp; 40 | begin 41 | AssertNotNull('Have range',Range); 42 | CheckRange('No args in constructor.',0,0,0,0); 43 | end; 44 | 45 | procedure TTestRange.TestAssign; 46 | 47 | Var 48 | B : TRange; 49 | 50 | begin 51 | B:=TRange.Create; 52 | B.Start.line:=12; 53 | B.Start.character:=13; 54 | B.&end.line:=14; 55 | B.&end.character:=15; 56 | try 57 | Range.Assign(B); 58 | finally 59 | b.Free; 60 | end; 61 | CheckRange('Assign',12,13,14,15); 62 | end; 63 | 64 | procedure TTestRange.TestConstructorLen; 65 | 66 | begin 67 | Range:=TRange.Create(10,11,15); 68 | CheckRange('Constructor with pos and length',10,11,10,26); 69 | end; 70 | 71 | procedure TTestRange.TestConstructorAllPos; 72 | begin 73 | Range:=TRange.Create(10,11,12,13); 74 | CheckRange('Constructor with explicit start and end',10,11,12,13); 75 | end; 76 | 77 | procedure TTestRange.TestSetRangeLen; 78 | begin 79 | Range.SetRange(10,11,15); 80 | CheckRange('Setrange with pos and length',10,11,10,26); 81 | end; 82 | 83 | procedure TTestRange.TestSetRangeAllPos; 84 | begin 85 | Range.SetRange(10,11,12,13); 86 | CheckRange('Constructor with explicit start and end',10,11,12,13); 87 | end; 88 | 89 | procedure TTestRange.TestToString; 90 | 91 | Const 92 | aResult = 'start: [10:11], end: [12:13]'; 93 | 94 | begin 95 | Range.SetRange(10,11,12,13); 96 | AssertEquals('ToString',aResult,Range.ToString); 97 | end; 98 | 99 | procedure TTestRange.SetRange(AValue: TRange); 100 | begin 101 | if FRange=AValue then Exit; 102 | FreeAndNil(FRange); 103 | FRange:=AValue; 104 | end; 105 | 106 | procedure TTestRange.SetUp; 107 | begin 108 | Range:=TRange.Create; 109 | end; 110 | 111 | procedure TTestRange.TearDown; 112 | begin 113 | FreeAndNil(FRange); 114 | end; 115 | 116 | procedure TTestRange.CheckRange(Msg: string; aStartLine, aStartChar, aEndLine, aEndChar: Integer); 117 | begin 118 | CheckRange(Msg,Range, aStartLine, aStartChar, aEndLine, aEndChar); 119 | end; 120 | 121 | class procedure TTestRange.CheckRange(Msg: string; aRange: TRange; aStartLine, 122 | aStartChar, aEndLine, aEndChar: Integer); 123 | begin 124 | AssertEquals(Msg+': Start line',aStartLine,aRange.Start.line); 125 | AssertEquals(Msg+': Start character',aStartChar,aRange.Start.character); 126 | AssertEquals(Msg+': End line',aEndLine,aRange.&end.line); 127 | AssertEquals(Msg+': End character',aEndChar,aRange.&end.character); 128 | end; 129 | 130 | initialization 131 | 132 | RegisterTest(TTestRange); 133 | end. 134 | 135 | -------------------------------------------------------------------------------- /src/tests/testlsp.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="12"/> 5 | <General> 6 | <SessionStorage Value="InProjectDir"/> 7 | <Title Value="testlsp"/> 8 | <UseAppBundle Value="False"/> 9 | <ResourceType Value="res"/> 10 | </General> 11 | <BuildModes> 12 | <Item Name="Default" Default="True"/> 13 | </BuildModes> 14 | <PublishOptions> 15 | <Version Value="2"/> 16 | <UseFileFilters Value="True"/> 17 | </PublishOptions> 18 | <RunParams> 19 | <FormatVersion Value="2"/> 20 | </RunParams> 21 | <RequiredPackages> 22 | <Item> 23 | <PackageName Value="lspserver"/> 24 | </Item> 25 | <Item> 26 | <PackageName Value="lspprotocol"/> 27 | </Item> 28 | <Item> 29 | <PackageName Value="FCL"/> 30 | </Item> 31 | </RequiredPackages> 32 | <Units> 33 | <Unit> 34 | <Filename Value="testlsp.lpr"/> 35 | <IsPartOfProject Value="True"/> 36 | </Unit> 37 | <Unit> 38 | <Filename Value="Tests.Basic.pas"/> 39 | <IsPartOfProject Value="True"/> 40 | </Unit> 41 | </Units> 42 | </ProjectOptions> 43 | <CompilerOptions> 44 | <Version Value="11"/> 45 | <Target> 46 | <Filename Value="testlsp"/> 47 | </Target> 48 | <SearchPaths> 49 | <IncludeFiles Value="$(ProjOutDir)"/> 50 | <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 51 | </SearchPaths> 52 | <Linking> 53 | <Debugging> 54 | <DebugInfoType Value="dsDwarf3"/> 55 | </Debugging> 56 | </Linking> 57 | </CompilerOptions> 58 | <Debugging> 59 | <Exceptions> 60 | <Item> 61 | <Name Value="EAbort"/> 62 | </Item> 63 | <Item> 64 | <Name Value="ECodetoolError"/> 65 | </Item> 66 | <Item> 67 | <Name Value="EFOpenError"/> 68 | </Item> 69 | </Exceptions> 70 | </Debugging> 71 | </CONFIG> 72 | -------------------------------------------------------------------------------- /src/tests/testlsp.lpr: -------------------------------------------------------------------------------- 1 | program testlsp; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | Classes, consoletestrunner, Tests.Basic; 7 | 8 | type 9 | 10 | { TMyTestRunner } 11 | 12 | TMyTestRunner = class(TTestRunner) 13 | protected 14 | // override the protected methods of TTestRunner to customize its behavior 15 | end; 16 | 17 | var 18 | Application: TMyTestRunner; 19 | 20 | begin 21 | DefaultFormat:=fPlain; 22 | DefaultRunAllTests:=True; 23 | Application := TMyTestRunner.Create(nil); 24 | Application.Initialize; 25 | Application.Title := 'FPCUnit Console test runner'; 26 | Application.Run; 27 | Application.Free; 28 | end. 29 | --------------------------------------------------------------------------------