From a0e268b1a9ef1eaa1459c8bc29438a5fe1ca45cb Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Thu, 17 Oct 2024 20:28:16 -0700 Subject: [PATCH] A bunch more changes --- elisp/ltex-eglot.el | 345 ++++++++++++++++++++++++++++++++++++++++++++ init.el | 196 ++++++++++++++++++------- 2 files changed, 488 insertions(+), 53 deletions(-) create mode 100644 elisp/ltex-eglot.el diff --git a/elisp/ltex-eglot.el b/elisp/ltex-eglot.el new file mode 100644 index 0000000..6f624fe --- /dev/null +++ b/elisp/ltex-eglot.el @@ -0,0 +1,345 @@ +;;; 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 diff --git a/init.el b/init.el index 9969250..15a7eaa 100644 --- a/init.el +++ b/init.el @@ -474,13 +474,34 @@ With NO-EDGE, return nil if beg or end fall on the edge of the range." (< beg (cdr sb)) (/= end (car sb)) (< end (cdr sb)))))) - ;; if the error happens, we aren't in as string + ;; if the error happens, we aren't in a string (wrong-type-argument nil)))) (defun my/-evil-cp-region-ok-p-no-string (oldfun beg end) - (or (my/range-inside-thing-p 'string beg end t) - (funcall oldfun beg end))) + (or + (my/range-inside-thing-p 'string beg end t) + (funcall oldfun beg end))) + (defun my/column-num-at-pos (pos) + "Return the column number at POS." + (save-excursion + (goto-char pos) + (current-column))) + (defun my/-evil-cp-block-ok-p-no-string (oldfun beg end) + (when (> beg end) (cl-rotatef beg end)) + (or + (funcall oldfun beg end) + (save-excursion + (goto-char beg) + (let ((start-off (current-column)) + (end-off (my/column-num-at-pos end))) + (cl-block nil + (dotimes (_ (count-lines beg end) t) + (let ((bol (pos-bol))) + (unless (sp-region-ok-p (+ bol start-off) + (+ bol end-off)) + (cl-return)) + (forward-line)))))))) (advice-add 'sp-region-ok-p :around 'my/-evil-cp-region-ok-p-no-string) - (advice-add 'evil-cp--balanced-block-p :around 'my/-evil-cp-region-ok-p-no-string)) + (advice-add 'evil-cp--balanced-block-p :around 'my/-evil-cp-block-ok-p-no-string)) ;; make lisp editing nicer (use-package aggressive-indent @@ -826,61 +847,125 @@ to `posframe-show' if the display is graphical." ;; flymake (use-package flymake - :bind (:map flymake-mode-map - ("C-c e" . my/flymake-show-diagnostic-at-point) - ("C-c C-e" . consult-flymake) - ("C-x c e" . consult-flymake)) - ;; :hook (emacs-lisp-mode . flymake-mode) - :init - (defun my/flymake-show-diagnostic-at-point () - (interactive) - (when flymake-mode - (let* ((diag (get-char-property (point) 'flymake-diagnostic)) - (diag-msg (when diag - (apply 'concat - (mapcar - (lambda (msg) - (concat "•" msg "\n")) - (split-string (flymake--diag-text diag) - "\n"))))) - (jinx-msg (when (jinx--get-overlays (point) (1+ (point))) - "•misspelled word\n"))) - (unless (and (zerop (length diag-msg)) - (zerop (length jinx-msg))) - (my/floating-tooltip " *flymake-error-posframe*" - (concat diag-msg jinx-msg))))))) + :config + (require 'consult-flymake)) ;; flycheck (use-package flycheck :hook (emacs-lisp-mode . flycheck-mode) - :bind (:map flycheck-mode-map - ("C-c e" . my/flycheck-show-diagnostic-at-point)) :custom (flycheck-indication-mode 'left-margin) :init - (setq flycheck-display-errors-function nil) - (defun my/flycheck-show-diagnostic-at-point () - (interactive) - (if-let ((flycheck-mode) - (message - (apply 'concat - (nconc (mapcar - (lambda (error) - (concat "•" (flycheck-error-message error) "\n")) - (flycheck-overlay-errors-at (point))) - (when (jinx--get-overlays (point) (1+ (point))) - '("•misspelled word\n"))))) - ((not (zerop (length message))))) - (my/floating-tooltip " *flycheck-error-posframe*" - (substring message 0 (1- (length message))))))) -(use-package consult-flycheck - :defer nil - :bind (:map flycheck-mode-map - ("C-c C-e" . consult-flycheck) - ("C-x c e" . consult-flycheck) - :map emacs-lisp-mode-map - ("C-c C-e" . consult-flycheck) - ("C-x c e" . consult-flycheck))) + (setq flycheck-display-errors-function nil)) +(use-package consult-flycheck) + +(defun my/diagnostic-at-point () + "Show the diagnostics under point." + (interactive) + (let ((message)) + (when-let ((flymake-mode) + (diag (get-char-property (point) 'flymake-diagnostic))) + (cl-callf nconc message (string-split (flymake--diag-text diag) "\n" t))) + (when flycheck-mode + (cl-callf nconc message + (mapcar 'flycheck-error-message (flycheck-overlay-errors-at (point))))) + ;; jinx + (when-let ((jinx-msg (jinx--get-overlays (point) (1+ (point))))) + (push "misspelled word" message)) + (when message + (my/floating-tooltip " *my-diagnostic-posframe*" + (mapconcat (lambda (msg) + (concat "•" msg)) + message "\n"))))) + +(defconst my/consult-flymake-flycheck-narrow + '((?e . "Error") + (?w . "Warning") + (?i . "Info") + (?n . "Info"))) + +(defun my/-consult-replace-flymake-error-level (candidates) + "Return CANDIDATES with the flymake error level note replaced with info." + (cl-loop for cand in candidates + collect + (cl-loop + with start = nil + for i below (length cand) + for props = (text-properties-at i cand) + for face = (plist-get props 'face) + when (eq face 'compilation-info) do + (setq start (or start i)) + else when start do + (setf (substring cand start i) + (propertize (string-pad "info" (- i start)) + 'face (flycheck-error-level-error-list-face + 'info))) + (cl-return cand) + finally return cand))) + +(defun my/consult-flymake-flycheck-candidates (&optional project) + "Return combined candidate list for flymake and flycheck. +With PROJECT, return the candiadeets for that project." + (let ((had-errors)) + (prog1 + (seq-uniq + (append + (when-let (((bound-and-true-p flymake-mode)) + (diags (if project (flymake--project-diagnostics + project) + (flymake-diagnostics)))) + (setq had-errors t) + (my/-consult-replace-flymake-error-level + (consult-flymake--candidates diags))) + (when (boundp 'flycheck-mode) + (if project + (cl-loop for buf in (project-buffers project) + append + (with-current-buffer buf + (when (and flycheck-mode flycheck-current-errors) + (setq had-errors t) + (consult-flycheck--candidates)))) + (when (and flycheck-mode flycheck-current-errors) + (setq had-errors t) + (consult-flycheck--candidates)))))) + (unless had-errors + (user-error "No errors (Flymake: %s | Flycheck: %s)" + (cond + ((not (bound-and-true-p flymake-mode)) + "not running") + ((seq-difference (flymake-running-backends) + (flymake-reporting-backends)) + "running") + (t "finished")) + (if (boundp 'flycheck-last-status-change) + flycheck-last-status-change + "not running")))))) + +(defun my/consult-flymake-flycheck (&optional project) + "Jump to flymake or flycheck error. +With PROJECT, give diagnostics for all buffers in the current project." + (interactive "P") + (consult--read + (consult--with-increased-gc + (my/consult-flymake-flycheck-candidates + (and project (project-current)))) + :prompt "Error: " + :category 'flymake-flycheck-error + :history t + :require-match t + :sort nil + :narrow (consult--type-narrow my/consult-flymake-flycheck-narrow) + :group (consult--type-group my/consult-flymake-flycheck-narrow) + :lookup #'consult--lookup-candidate + :state (consult--jump-state))) +(with-eval-after-load 'flymake + (define-key flymake-mode-map (kbd "C-c e") 'my/diagnostic-at-point) + (define-key flymake-mode-map (kbd "C-c C-e") 'my/consult-flymake-flycheck)) +(with-eval-after-load 'flycheck + (define-key flycheck-mode-map (kbd "C-c e") 'my/diagnostic-at-point) + (define-key flycheck-mode-map (kbd "C-c C-e") 'my/consult-flymake-flycheck)) +(with-eval-after-load 'jinx + (define-key jinx-mode-map (kbd "C-c e") 'my/diagnostic-at-point)) ;; eldoc (use-package eldoc @@ -948,6 +1033,9 @@ to `posframe-show' if the display is graphical." "--header-insertion=never" "--pch-storage=memory" "--function-arg-placeholders")))) +;; LTeX (languagetool) +(require 'ltex-eglot) + ;; gud (use-package gud :demand t @@ -1226,7 +1314,8 @@ otherwise, call `bibtex-find-text'." :hook ((LaTeX-mode . turn-on-reftex) (LaTeX-mode . LaTeX-math-mode) (LaTeX-mode . my/-setup-LaTeX-mode) - (LaTeX-mode . flycheck-mode)) + (LaTeX-mode . flycheck-mode) + (LaTeX-mode . eglot-ensure)) :bind (:map TeX-mode-map ("C-c ?" . latex-help)) :init @@ -1237,6 +1326,7 @@ otherwise, call `bibtex-find-text'." (add-to-list 'major-mode-remap-alist '(texinfo-mode . Texinfo-mode)) (add-to-list 'major-mode-remap-alist '(doctex-mode . docTeX-mode)) (add-to-list 'auto-mode-alist '("/\\.latexmkrc\\'" . perl-mode)) + (add-to-list 'auto-mode-alist '("\\.[tT]e[xX]\\'" . LaTeX-mode)) :config (defun my/-auctex-texdoc-setup-env (oldfun &rest args) (let ((process-environment process-environment)