Draft of FsProj Enhancements

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)

fsharp-mode.el

@@ -341,25 +341,37 @@ 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)
       p)))
 
 ;; 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)))

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 <amcguier@gmail.com>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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