diff --git a/eglot-fsharp.el b/eglot-fsharp.el index 5438f5b..bff4a26 100644 --- a/eglot-fsharp.el +++ b/eglot-fsharp.el @@ -56,24 +56,66 @@ :type '(repeat string)) (defcustom eglot-fsharp-fsautocomplete-args '( - :automaticWorkspaceInit t - :keywordsAutocomplete t - :externalAutocomplete nil - :linter t - :unionCaseStubGeneration t - :recordStubGeneration t - :interfaceStubGeneration t - :interfaceStubGenerationObjectIdentifier "this" - :unusedOpensAnalyzer t - :unusedDeclarationsAnalyzer t - :useSdkScripts t - :simplifyNameAnalyzer nil - :resolveNamespaces t - :enableReferenceCodeLens t) - "Arguments for the fsautocomplete initialization." - :group 'eglot-fsharp - :risky t - ) + :automaticWorkspaceInit t + :abstractClassStubGeneration t + :abstractClassStubGenerationMethodBody + "failwith \"Not Implemented\"" + :abstractClassStubGenerationObjectIdentifier "this" + :addFsiWatcher nil + :codeLenses (:references (:enabled t) + :signature (:enabled t)) + :disableFailedProjectNotifications nil + :dotnetRoot "" + :enableAdaptiveLspServer t + :enableAnalyzers nil + :enableMSBuildProjectGraph nil + :enableReferenceCodeLens t + :excludeProjectDirectories [".git" "paket-files" ".fable" "packages" "node_modules"] + :externalAutocomplete nil + :fsac (:attachDebugger nil + :cachedTypeCheckCount 200 + :conserveMemory nil + :dotnetArgs nil + :netCoreDllPath "" + :parallelReferenceResolution nil + :silencedLogs nil) + :fsiExtraParameters nil + :fsiSdkFilePath "" + :generateBinlog nil + :indentationSize 4 + :inlayHints (:disableLongTooltip nil + :enabled t + :parameterNames t + :typeAnnotations t) + :inlineValues (:enabled nil + :prefix "//") + :interfaceStubGeneration t + :interfaceStubGenerationMethodBody "failwith \"Not Implemented\"" + :interfaceStubGenerationObjectIdentifier "this" + :keywordsAutocomplete t + :lineLens (:enabled "replaceCodeLens" + :prefix " // ") + :linter t + :pipelineHints (:enabled t + :prefix " // ") + :recordStubGeneration t + :recordStubGenerationBody "failwith \"Not Implemented\"" + :resolveNamespaces t + :saveOnSendLastSelection nil + :simplifyNameAnalyzer t + :smartIndent nil + :suggestGitignore t + :suggestSdkScripts t + :unionCaseStubGeneration t + :unionCaseStubGenerationBody "failwith \"Not Implemented\"" + :unusedDeclarationsAnalyzer t + :unusedOpensAnalyzer t + :verboseLogging nil + :workspaceModePeekDeepLevel 4 + :workspacePath "") + "Arguments for the fsautocomplete workspace configuration." + :group 'eglot-fsharp + :risky t) (defun eglot-fsharp--path-to-server () "Return FsAutoComplete path." @@ -142,11 +184,58 @@ (unless (eglot-fsharp-current-version-p version) (eglot-fsharp--install-core version)))) - ;;;###autoload +;;; File manipulation + +(defun eglot-fsharp--get-relative-file-name () + "Get a file object type from the current fs file." + (let* ((project-name (fsharp-mode/find-sln-or-fsproj (buffer-file-name))) + (file-name (string-remove-prefix (file-name-directory project-name) + (buffer-file-name)))) + `(:fsProj ,project-name + :fileVirtualPath ,file-name))) + +(defun eglot-fsharp-add-to-project () + "Add the current file to the closest project." + (interactive) + (jsonrpc-request (eglot--current-server-or-lose) + :fsproj/addFile (eglot-fsharp--get-relative-file-name))) + +(defun eglot-fsharp-remove-from-project () + "Remove the current file to the closest project." + (interactive) + (jsonrpc-request (eglot--current-server-or-lose) + :fsproj/removeFile (eglot-fsharp--get-relative-file-name))) + +(defun eglot-fsharp-rename-file () + "Rename the current file." + (interactive) + (let* ((partial-obj (eglot-fsharp--get-relative-file-name)) + (new-name (read-file-name "rename: " (file-name-directory (buffer-file-name)))) + (replacement-obj `(:fsProj ,(plist-get partial-obj :fsProj) + :oldFileVirtualPath ,(plist-get partial-obj :fileVirtualPath) + :newFileName , (file-name-nondirectory new-name)))) + (progn (save-buffer) + (jsonrpc-request (eglot--current-server-or-lose) + :fsproj/renameFile replacement-obj) + (find-alternate-file new-name) + ))) + + + +;;; create buffer local settings for workspace reload based on mode hook + +(defun eglot-fsharp--set-workspace-args () + "Set a buffer local variable with the workspace settings for eglot." + (make-local-variable 'eglot-workspace-configuration) + (let ((settings-json (json-serialize eglot-fsharp-fsautocomplete-args)) ) + (setq eglot-workspace-configuration settings-json ))) + +;;;###autoload (defun eglot-fsharp (interactive) - "Return `eglot' contact when FsAutoComplete is installed. + "Return `eglot' contact when FsAutoComplete is installed. Ensure FsAutoComplete is installed (when called INTERACTIVE)." (when interactive (eglot-fsharp--maybe-install)) + (eglot-fsharp--set-workspace-args) (cons 'eglot-fsautocomplete (if (file-remote-p default-directory) `("sh" ,shell-command-switch ,(concat "cat|" (mapconcat #'shell-quote-argument @@ -159,11 +248,11 @@ Ensure FsAutoComplete is installed (when called INTERACTIVE)." (cl-defmethod eglot-initialization-options ((_server eglot-fsautocomplete)) "Passes through required FsAutoComplete initialization options." - `(:fSharp ,eglot-fsharp-fsautocomplete-args)) + eglot-fsharp-fsautocomplete-args) ;; FIXME: this should be fixed in FsAutocomplete (cl-defmethod xref-backend-definitions :around ((_type symbol) _identifier) - "FsAutoComplete breaks spec and and returns error instead of empty list." + "FsAutoComplete breaks spec and and return error instead of empty list." (if (eq major-mode 'fsharp-mode) (condition-case err (cl-call-next-method) @@ -172,6 +261,8 @@ Ensure FsAutoComplete is installed (when called INTERACTIVE)." (when (cl-next-method-p) (cl-call-next-method)))) + + (add-to-list 'eglot-server-programs `(fsharp-mode . eglot-fsharp)) (provide 'eglot-fsharp) diff --git a/fsharp-mode.el b/fsharp-mode.el index c8720ab..f01de7b 100644 --- a/fsharp-mode.el +++ b/fsharp-mode.el @@ -341,17 +341,29 @@ whole string." ;;; Project -(defun fsharp-mode/find-sln-or-fsproj (dir-or-file) - "Search for a solution or F# project file in any enclosing -folders relative to DIR-OR-FILE." - (fsharp-mode-search-upwards (rx (0+ nonl) (or ".fsproj" ".sln") eol) - (file-name-directory dir-or-file))) - (defun fsharp-mode-search-upwards (regex dir) (when dir (or (car-safe (directory-files dir 'full regex)) (fsharp-mode-search-upwards regex (fsharp-mode-parent-dir dir))))) +(defun fsharp-mode/search-file (dir-or-file extension-regex) + "Search for the provided file-extension in any enclosing folder relative to dir." + (fsharp-mode-search-upwards (rx (0+ nonl) (regexp extension-regex) eol) + (file-name-directory dir-or-file))) + +(defun fsharp-mode/find-sln-or-fsproj (dir-or-file) + "Search for a solution or F# project file in any enclosing folders relative to DIR-OR-FILE." + (fsharp-mode/search-file (file-name-directory dir-or-file) (or ".fsproj" ".sln"))) + + +(defun fsharp-mode/find-proj-context (dir-or-file) + "Search for a project, or a solution in DIR-OR-FILE but prefer a solution file when found." + (when-let (generic-project (fsharp-mode/find-sln-or-fsproj dir-or-file)) + (if-let (sln-file (fsharp-mode/search-file dir-or-file (rx ".sln"))) + sln-file + generic-project))) + + (defun fsharp-mode-parent-dir (dir) (let ((p (file-name-directory (directory-file-name dir)))) (unless (equal p dir) @@ -359,7 +371,7 @@ folders relative to DIR-OR-FILE." ;; Make project.el aware of fsharp projects (defun fsharp-mode-project-root (dir) - (when-let (project-file (fsharp-mode/find-sln-or-fsproj dir)) + (when-let (project-file (fsharp-mode/find-proj-context dir)) (cons 'fsharp (file-name-directory project-file)))) (cl-defmethod project-roots ((project (head fsharp))) diff --git a/fsproj-mode.el b/fsproj-mode.el new file mode 100644 index 0000000..7b9fd29 --- /dev/null +++ b/fsproj-mode.el @@ -0,0 +1,96 @@ +;;; fsproj-mode.el -- fsproj-mode eglot fsharp integration -*- lexical-binding: t; -*- +;; Copyright (C) 2023 Andrew McGuier + +;; Author: Andrew McGuier +;; Package-Requires: ((emacs "27.1") (eglot "1.4") (jsonrpc "1.0.14")) +;; Version: 1.10 +;; Keywords: languages +;; URL: https://github.com/fsharp/emacs-fsharp-mode + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + + +;;; Code: +(require 'dom) +(require 'eglot) + +(defvar fsproj-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'fsproj-move-up) + (define-key map "d" 'fsproj-move-down) map) + "Local keymap for `fsproj-mode' buffers.") + + +(defun fsproj--read-files (file-name) + "Pull out all the compileable files in an fsproj file in FILE-NAME." + (with-temp-buffer (insert-file-contents file-name) + (mapcar (lambda (x) + (list nil (vector (dom-attr x 'Include)))) + (dom-by-tag (libxml-parse-xml-region (point-min) + (point-max)) 'Compile)))) + +(defun fsproj--set-tab-list () + "Use the local fsproj-name variable to calculate the list of fsproj files to display." + (setq-local tabulated-list-entries (fsproj--read-files fsproj-name))) + + +(defun fsproj-list-files () + "Read an fsproj file contents and allow manipulating the file contents. +This functionality requires eglot to function and should be called on an +fs file with an active eglot session." + (interactive) + (let ((current-server (eglot--current-server-or-lose)) + (fsproj-nm (fsharp-mode/find-sln-or-fsproj (buffer-file-name)))) + (pop-to-buffer (concat "*" (file-name-nondirectory fsproj-nm) " info*")) + (fsproj-mode) + (setq-local current-eglot-server current-server) + (setq-local fsproj-name fsproj-nm) + (fsproj--set-tab-list) + (tabulated-list-print t))) + +(defun fsproj-move-up () + "Move file up in the compilation order." + (interactive) + (let ((file-name (elt (tabulated-list-get-entry) 0))) + (if file-name (progn (jsonrpc-request current-eglot-server + :fsproj/moveFileUp `(:fsProj ,fsproj-name + :fileVirtualPath ,file-name)) + (tabulated-list-revert) + (previous-line))))) + +(defun fsproj-move-down () + "Move file up in the compilation order." + (interactive) + (let ((file-name (elt (tabulated-list-get-entry) 0))) + (if file-name (progn (jsonrpc-request current-eglot-server + :fsproj/moveFileDown `(:fsProj ,fsproj-name + :fileVirtualPath ,file-name)) + (tabulated-list-revert) + (next-line))))) + +(define-derived-mode fsproj-mode tabulated-list-mode + "fsproj" + "Major mode for fsproj." + (setq-local tabulated-list-format [("File Name" 10 nil) ]) + (tabulated-list-init-header) + (add-hook 'tabulated-list-revert-hook 'fsproj--set-tab-list nil t)) + +(add-to-list 'auto-mode-alist '("\\.fsproj info?\\'" . fsproj-mode)) + + + +(provide 'fsproj-mode) +;;; fsproj-mode.el ends here