emacs-config/elisp/ltex-eglot.el

346 lines
14 KiB
EmacsLisp

;;; ltex-eglot.el --- LTeX support for Eglot. -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(require 'eglot)
(defcustom ltex-eglot-server-binary "ltex-ls"
"The binary to use for the LTeX LSP server."
:group 'ltex-eglot
:type 'string)
(defconst ltex-eglot-modes
;; Source:
;; https://github.com/emacs-languagetool/eglot-ltex/blob/master/eglot-ltex.el
'((org-mode :language-id "org")
(git-commit-elisp-text-mode :language-id "gitcommit")
(bibtex-mode :language-id "bibtex")
(context-mode :language-id "context")
(latex-mode :language-id "latex")
(LaTeX-mode :language-id "latex")
(markdown-mode :language-id "markdown")
(rst-mode :language-id "restructuredtext")
(text-mode :language-id "plaintext"))
"List of major mode that work with LanguageTool.")
(defcustom ltex-eglot-mother-tounge "en-US"
"The user's native language."
:group 'ltex-eglot
:type '(string :tag "Language Code"))
(defcustom ltex-eglot-language ltex-eglot-mother-tounge
"The main language to use when checking documents."
:group 'ltex-eglot
:type '(choice :tag "Language"
(const :tag "Detect Automatically" "auto")
(string :tag "Language Code"))
:set-after '(ltex-eglot-mother-tounge)
:safe 'stringp)
(defcustom ltex-eglot-enable-spell-check nil
"Weather or not to enable spell checking with LTeX."
:group 'ltex-eglot
:type '(choice :tag "Status"
(const :tag "Enabled" t)
(const :tag "Disabled" nil)))
(defun ltex-eglot--entry-file-p (entry)
"Check if ENTRY would be concidered a file by LTex LSP."
(when (stringp entry)
(string-prefix-p ":" entry)))
(defun ltex-eglot--non-file-settings-plist-p (plist)
"Return non-nil if none of the values of PLIST refer to files.
This is meant to check file-local saftey for the likes of
`ltex-eglot-disabled-rules'."
(cl-loop for (_ entries) on plist by 'cddr
when (cl-some 'ltex-eglot--entry-file-p entries)
do (cl-return)
finally return t))
(defcustom ltex-eglot-disabled-rules ()
"List of diagnostic rules to disable."
:group 'ltex-eglot
:type '(plist :tag "Entries by language"
:key-type (string :tag "Language Code")
:value-type (repeat :tag "Rules" string))
:safe 'ltex-eglot--non-file-settings-plist-p)
(defcustom ltex-eglot-enabled-rules ()
"List of diagnostic rules to enable."
:group 'ltex-eglot
:type '(plist :tag "Entries by language"
:key-type (string :tag "Language Code")
:value-type (repeat :tag "Rules" string))
:safe 'ltex-eglot--non-file-settings-plist-p)
(defcustom ltex-eglot-dictionary ()
"List of words in the LTeX dictionary."
:group 'ltex-eglot
:type '(plist :tag "Entries by language"
:key-type (string :tag "Language Code")
:value-type (repeat :tag "Words" string))
:safe 'ltex-eglot--non-file-settings-plist-p)
(defun ltex-eglot--valid-latex-plist-p (plist)
"Return non-nil if PLIST is an OK value for LaTeX options."
(cl-loop for (name handling) on plist by 'cddr
unless (and (stringp name)
(member handling '("ignore" "default")))
do (cl-return)
finally return t))
(defcustom ltex-eglot-latex-environments ()
"Plist controlling the handling of LaTeX environments."
:group 'ltex-eglot
:type '(plist
:tag "Environments"
:key-type (string :tag "Name")
:value-type (choice :tag "Handling"
(const :tag "Ignore" "ignore")
(const :tag "Check" "default")))
:safe 'ltex-eglot--valid-latex-plist-p)
(defcustom ltex-eglot-latex-commands ()
"Plist controlling the handling of LaTeX commands."
:group 'ltex-eglot
:type '(plist
:tag "Commands"
:key-type (string :tag "Name")
:value-type (choice :tag "Handling"
(const :tag "Ignore" "ignore")
(const :tag "Check" "default")))
:safe 'ltex-eglot--valid-latex-plist-p)
(defun ltex-eglot--valid-bibtex-plist-p (plist)
"Return non-nil if PLIST is an OK value for BibTeX options."
(cl-loop for (name handling) on plist by 'cddr
unless (and (stringp name)
(booleanp handling))
do (cl-return)
finally return t))
(defcustom ltex-eglot-bibtex-fields ()
"Plist controlling the handling of BibTeX fields."
:group 'ltex-eglot
:type '(plist
:tag "Fields"
:key-type (string :tag "Name")
:value-type (choice :tag "Handling"
(const :tag "Ignore" nil)
(const :tag "Check" t)))
:safe 'ltex-eglot--valid-bibtex-plist-p)
(defcustom ltex-eglot-enable-picky-rules nil
"Weather or not to enable picky rules."
:group 'ltex-eglot
:type '(choice :tag "Status"
(const :tag "Enabled" t)
(const :tag "Disabled" nil))
:safe 'booleanp)
(defvar ltex-eglot-hidden-false-positives nil
"List of hidden false positives.
This is intented to be set from .dir-locals.el.")
(put 'ltex-eglot-hidden-false-positives 'safe-local-variable
'ltex-eglot--non-file-settings-plist-p)
(defun ltex-eglot--merge-options-plists (value-type &rest lists)
"Merge each of the options plist LISTS.
The values of each of the props can be any sequence, and will be converted to
VALUE-TYPE. Any keys will be converted to keyword symbols if they are strings."
(let ((output))
(dolist (list lists output)
(cl-loop for (prop value) on list by 'cddr
for norm-prop = (if (stringp prop)
(intern (concat ":" prop))
prop)
do
(setf (plist-get output norm-prop)
(cl-coerce (seq-uniq
(seq-concatenate 'list
(plist-get output norm-prop)
value))
value-type))))))
(defun ltex-eglot--process-and-add-global (global &rest lists)
"Merge each of LISTS with `ltex-eglot--merge-options-plists'.
If the result of the merger results in a list with the key t, merge GLOBAL in as
well."
(let ((merged (apply 'ltex-eglot--merge-options-plists 'vector lists)))
(cl-loop with found-t = nil
for (prop value) on merged by 'cddr
when (eq prop t) do
(setq found-t t)
else collect prop into output
and collect value into output
finally return
(if found-t
(ltex-eglot--merge-options-plists 'vector output global)
output))))
(defun ltex-eglot--make-plist-props-symbols (plist)
"Make each of PLIST's props a symbol by calling `intern' on it."
(cl-loop for (prop value) on plist by 'cddr
collect (if (stringp prop)
(intern (concat ":" prop))
prop)
collect value))
(defun ltex-eglot--process-bibtex-fields-plist (plist)
"Process a PLIST that might be `ltex-eglot-bibtex-fields'."
(cl-loop for (prop value) on plist by 'cddr
collect (if (stringp prop)
(intern (concat ":" prop))
prop)
collect (or value :json-false)))
;; The ltex server doesn't work with eglot when running in standard io mode
(defclass ltex-eglot-server (eglot-lsp-server)
((setup-done-p :initform nil
:accessor ltex-eglot-server--setup-done-p)
(hidden-positives :initform nil
:accessor ltex-eglot-server--hidden-positives)
(dictionary :initform nil
:accessor ltex-eglot-server--dictionary)
(disabled-rules :initform nil
:accessor ltex-eglot-server--disabled-rules))
"LTeX server class.")
(cl-defmethod ltex-eglot--disabled-rules-plist ((server ltex-eglot-server))
"Create a plist of disabled rules by language.
SERVER is the server from which to get the rules."
(ltex-eglot--process-and-add-global
(default-value 'ltex-eglot-disabled-rules)
(ltex-eglot-server--disabled-rules server)
(and (not ltex-eglot-enable-spell-check)
'(:en-US ["EN_CONTRACTION_SPELLING" "MORFOLOGIK_RULE_EN_US"]))))
(cl-defmethod ltex-eglot--setup-server ((server ltex-eglot-server))
"Setup up SERVER for the first time."
;; make sure that dir local stuff is picked up
(save-current-buffer
(when-let ((buf (cl-first (eglot--managed-buffers server))))
(set-buffer buf))
(setf
;; merger of global values is mediated elsewhere
(ltex-eglot-server--hidden-positives server)
(if (local-variable-p 'ltex-eglot-hidden-false-positives)
ltex-eglot-hidden-false-positives
'(t))
(ltex-eglot-server--disabled-rules server)
(if (local-variable-p 'ltex-eglot-disabled-rules)
ltex-eglot-disabled-rules
'(t))
(ltex-eglot-server--dictionary server)
(if (local-variable-p 'ltex-eglot-dictionary)
ltex-eglot-dictionary
'(t))
(ltex-eglot-server--setup-done-p server) t)))
(cl-defmethod ltex-eglot--build-workspace-settings-plist ((server ltex-eglot-server))
"Build the workspace settings plist for SERVER."
(unless (ltex-eglot-server--setup-done-p server)
(ltex-eglot--setup-server server))
(list
:language ltex-eglot-language
:dictionary (ltex-eglot--process-and-add-global
(default-value 'ltex-eglot-dictionary)
(ltex-eglot-server--dictionary server))
:disabledRules (ltex-eglot--disabled-rules-plist server)
:enabledRules (ltex-eglot--merge-options-plists
'vector
ltex-eglot-enabled-rules)
:hiddenFalsePositives (ltex-eglot--process-and-add-global
(default-value 'ltex-eglot-hidden-false-positives)
(ltex-eglot-server--hidden-positives server))
:latex (list :commands (ltex-eglot--make-plist-props-symbols
ltex-eglot-latex-commands)
:environments (ltex-eglot--make-plist-props-symbols
ltex-eglot-latex-environments))
:bibtex (list :fields (ltex-eglot--process-bibtex-fields-plist
ltex-eglot-bibtex-fields))
:additionalRules (list :motherTongue ltex-eglot-mother-tounge
:enablePickyRules
(or ltex-eglot-enabled-rules :json-false))))
(defun ltex-eglot--cleanup-plist-for-dir-locals (plist)
"Cleanup PLIST for use in a .dir-locals.el file."
(cl-loop with has-global = nil
for (prop value) on plist by 'cddr
when (eq prop t) do
(setq has-global t)
else collect prop into output
and collect value into output
finally
(when has-global
(cl-callf nconc output (list t)))
finally return output))
(defun ltex-eglot--handle-client-action (server command slot)
"Handle the client side action COMMAND for SERVER.
SLOT is a slot in SERVER."
(let* ((arg (cl-case slot
(disabled-rules :ruleIds)
(hidden-positives :falsePositives)
(dictionary :words)))
(local-var (cl-case slot
(disabled-rules 'ltex-eglot-disabled-rules)
(hidden-positives 'ltex-eglot-hidden-false-positives)
(dictionary 'ltex-eglot-dictionary)))
(args (elt (plist-get command :arguments) 0))
(newval (ltex-eglot--merge-options-plists
'list
(slot-value server slot) (plist-get args arg))))
(add-dir-local-variable nil local-var
(ltex-eglot--cleanup-plist-for-dir-locals newval))
(setf (slot-value server slot) newval)
(dolist (buf (eglot--managed-buffers server))
(setf (buffer-local-value local-var buf) newval))
(eglot-signal-didChangeConfiguration server)))
(cl-defmethod eglot-execute ((server ltex-eglot-server) action)
"Handelr for LTeX actions.
ACTION is the action which to run on SERVER."
(let ((kind (plist-get action :kind)))
(pcase kind
("quickfix.ltex.disableRules"
(ltex-eglot--handle-client-action server (plist-get action :command)
'disabled-rules))
("quickfix.ltex.hideFalsePositives"
(ltex-eglot--handle-client-action server (plist-get action :command)
'hidden-positives))
("quickfix.ltex.addToDictionary"
(ltex-eglot--handle-client-action server (plist-get action :command)
'dictionary))
(_ (cl-call-next-method)))))
(defun ltex-eglot--hack-server-config (oldfun server &optional path)
"Hack the config for SERVER into the return of ODLFUN.
PATH is the same as for OLDFUN, which is probably
`eglot--workspace-configuration-plist'."
(let ((conf (funcall oldfun server path)))
(when (object-of-class-p server 'ltex-eglot-server)
(let ((ltex-conf (plist-get conf :ltex)))
(cl-loop for (prop val) on
(ltex-eglot--build-workspace-settings-plist server)
by 'cddr
unless (plist-member ltex-conf prop)
do (setf (plist-get ltex-conf prop) val))
(setf (plist-get conf :ltex) ltex-conf)))
conf))
;;;###autoload
(add-to-list 'eglot-server-programs
(cons ltex-eglot-modes
(list
'ltex-eglot-server
ltex-eglot-server-binary "--server-type" "TcpSocket"
"--port" :autoport)))
;;;###autoload
(advice-add 'eglot--workspace-configuration-plist :around
'ltex-eglot--hack-server-config)
(provide 'ltex-eglot)
;;; ltex-eglot.el ends here