A *TON* of changes

This commit is contained in:
2024-10-20 00:44:30 -07:00
parent 003bc783d7
commit b54abacff3
3 changed files with 535 additions and 32 deletions

View File

@ -3,6 +3,14 @@
;;; Code:
(require 'eglot)
(defconst ltex-eglot-supported-languages
'("ar" "ast-ES" "be-BY" "br-FR" "ca-ES" "ca-ES-valencia" "da-DK" "de" "de-AT"
"de-CH" "de-DE" "de-DE-x-simple-language" "el-GR" "en" "en-AU" "en-CA" "en-GB"
"en-NZ" "en-US" "en-ZA" "eo" "es" "es-AR" "fa" "fr" "ga-IE" "gl-ES" "it"
"ja-JP" "km-KH" "nl" "nl-BE" "pl-PL" "pt" "pt-AO" "pt-BR" "pt-MZ" "pt-PT"
"ro-RO" "ru-RU" "sk-SK" "sl-SI" "sv" "ta-IN" "tl-PH" "uk-UA" "zh-CN")
"List of languages supportd by LTeX.")
(defcustom ltex-eglot-server-binary "ltex-ls"
"The binary to use for the LTeX LSP server."
:group 'ltex-eglot
@ -43,6 +51,14 @@
(const :tag "Enabled" t)
(const :tag "Disabled" nil)))
(defcustom ltex-eglot-spell-check-rules
'(:en-US ["EN_CONTRACTION_SPELLING" "MORFOLOGIK_RULE_EN_US"])
"Rules to disable if `ltex-eglot-enable-spell-check' is nil."
:group 'ltex-eglot
:type '(plist :tag "Entries by language"
:key-type (string :tag "Language Code")
:value-type (repeat :tag "Rules" string)))
(defun ltex-eglot--entry-file-p (entry)
"Check if ENTRY would be concidered a file by LTex LSP."
(when (stringp entry)
@ -81,8 +97,8 @@ This is meant to check file-local saftey for the likes of
: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."
(defun ltex-eglot--valid-latex-environments-p (plist)
"Check if PLIST is an OK value for the `ltex-eglot-latex-environemnts'."
(cl-loop for (name handling) on plist by 'cddr
unless (and (stringp name)
(member handling '("ignore" "default")))
@ -100,6 +116,15 @@ This is meant to check file-local saftey for the likes of
(const :tag "Check" "default")))
:safe 'ltex-eglot--valid-latex-plist-p)
(defun ltex-eglot--valid-latex-commands-p (plist)
"Check if PLIST is an OK value for the `ltex-eglot-latex-commands'."
(cl-loop for (name handling) on plist by 'cddr
unless (and (stringp name)
(member handling '("ignore" "default" "dummy"
"pluralDummy" "vowelDummy")))
do (cl-return)
finally return t))
(defcustom ltex-eglot-latex-commands ()
"Plist controlling the handling of LaTeX commands."
:group 'ltex-eglot
@ -107,8 +132,13 @@ This is meant to check file-local saftey for the likes of
:tag "Commands"
:key-type (string :tag "Name")
:value-type (choice :tag "Handling"
(const :tag "Default" "default")
(const :tag "Ignore" "ignore")
(const :tag "Check" "default")))
(const :tag "Replace with dummy word" "dummy")
(const :tag "Replace with dummy plural word"
"pluralDummy")
(const :tag "Replace with dummy vowel word"
"vowelDummy")))
:safe 'ltex-eglot--valid-latex-plist-p)
(defun ltex-eglot--valid-bibtex-plist-p (plist)
@ -138,6 +168,19 @@ This is meant to check file-local saftey for the likes of
(const :tag "Disabled" nil))
:safe 'booleanp)
(defcustom ltex-eglot-variable-save-method 'dir
"How to save variables added by quick fixes.
This is one of the following:
- \\='dir\tSave in .dir-locals.el
- \\='file\tSave as a file local variable
- nil\tJust set the buffer local value, don't save the variable"
:group 'ltex-eglot
:type '(choice :tag "Save method"
(const :tag "Directory local (saved)" dir)
(const :tag "File local (saved)" file)
(const :tag "Buffer local (not saved)" nil))
:safe 'symbolp)
(defvar ltex-eglot-hidden-false-positives nil
"List of hidden false positives.
This is intented to be set from .dir-locals.el.")
@ -203,7 +246,9 @@ well."
(dictionary :initform nil
:accessor ltex-eglot-server--dictionary)
(disabled-rules :initform nil
:accessor ltex-eglot-server--disabled-rules))
:accessor ltex-eglot-server--disabled-rules)
(language :initform nil
:accessor ltex-eglot-server--language))
"LTeX server class.")
(cl-defmethod ltex-eglot--disabled-rules-plist ((server ltex-eglot-server))
@ -213,7 +258,7 @@ SERVER is the server from which to get the rules."
(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"]))))
ltex-eglot-spell-check-rules)))
(cl-defmethod ltex-eglot--setup-server ((server ltex-eglot-server))
"Setup up SERVER for the first time."
@ -235,6 +280,7 @@ SERVER is the server from which to get the rules."
(if (local-variable-p 'ltex-eglot-dictionary)
ltex-eglot-dictionary
'(t))
(ltex-eglot-server--language server) ltex-eglot-language
(ltex-eglot-server--setup-done-p server) t)))
(cl-defmethod ltex-eglot--build-workspace-settings-plist ((server ltex-eglot-server))
@ -242,7 +288,7 @@ SERVER is the server from which to get the rules."
(unless (ltex-eglot-server--setup-done-p server)
(ltex-eglot--setup-server server))
(list
:language ltex-eglot-language
:language (ltex-eglot-server--language server)
:dictionary (ltex-eglot--process-and-add-global
(default-value 'ltex-eglot-dictionary)
(ltex-eglot-server--dictionary server))
@ -276,6 +322,16 @@ SERVER is the server from which to get the rules."
(cl-callf nconc output (list t)))
finally return output))
(cl-defmethod ltex-eglot--set-variable ((server ltex-eglot-server)
variable value)
"Set VARIABLE to VALUE in each buffer for SERVER.
Also, maybe save VARIABLE in .dir-locals.el or as a file local variable."
(cl-case ltex-eglot-variable-save-method
(dir (add-dir-local-variable nil variable value))
(file (add-file-local-variable variable value)))
(dolist (buf (eglot--managed-buffers server))
(setf (buffer-local-value variable buf) value)))
(defun ltex-eglot--handle-client-action (server command slot)
"Handle the client side action COMMAND for SERVER.
SLOT is a slot in SERVER."
@ -291,15 +347,12 @@ SLOT is a slot in SERVER."
(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))
(ltex-eglot--set-variable server local-var newval)
(eglot-signal-didChangeConfiguration server)))
(cl-defmethod eglot-execute ((server ltex-eglot-server) action)
"Handelr for LTeX actions.
"Handler for LTeX actions.
ACTION is the action which to run on SERVER."
(let ((kind (plist-get action :kind)))
(pcase kind
@ -319,7 +372,7 @@ ACTION is the action which to run on SERVER."
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)
(when (ltex-eglot-server-p server)
(let ((ltex-conf (plist-get conf :ltex)))
(cl-loop for (prop val) on
(ltex-eglot--build-workspace-settings-plist server)
@ -329,13 +382,31 @@ PATH is the same as for OLDFUN, which is probably
(setf (plist-get conf :ltex) ltex-conf)))
conf))
(defun ltex-eglot-set-language (language server &optional no-save)
"Set the SERVER's language to LANGUAGE.
When called interactively, prompt for LANGUAGE. With NO-SAVE, don't save the
language setting in any file."
(interactive (list (completing-read "Language"
ltex-eglot-supported-languages)
(eglot-current-server)
current-prefix-arg))
(unless (ltex-eglot-server-p server)
(user-error "Current server is not an LTeX server!"))
(when-let ((server (eglot-current-server)))
(setf (ltex-eglot-server--language server) language)
(let ((ltex-eglot-variable-save-method
(and (not no-save)
ltex-eglot-variable-save-method)))
(ltex-eglot--set-variable server 'ltex-eglot-language language))
(eglot-signal-didChangeConfiguration server)))
;;;###autoload
(add-to-list 'eglot-server-programs
(cons ltex-eglot-modes
(list
'ltex-eglot-server
ltex-eglot-server-binary "--server-type" "TcpSocket"
"--port" :autoport)))
"--no-endless" "--port" :autoport)))
;;;###autoload
(advice-add 'eglot--workspace-configuration-plist :around

354
elisp/org-mu4e-compose.el Normal file
View File

@ -0,0 +1,354 @@
;;; org-mu4e-compose.el --- Write mu4e messages with org-mode. -*- lexical-binding: t; -*-
;;; Commentary:
;; I use evil. This file does not depend on evil, but some of these keybindings
;; shadow useful org keybinding with message mode keybindings because the org
;; bindings being shadowed are available with evil under some other key sequence.
;;; Code:
(require 'mu4e)
(require 'org-mime)
(require 'shr)
(require 'dom)
(require 'sgml-mode)
(require 'cl-lib)
(defvar-local org-mu4e--html-message-p t
"Weather or not the current message should be htmlized.")
(defvar-local org-mu4e--override-org-mode-check nil
"Internal variable.
See `org-mu4e--override-org-mode-check-advice' for information about what this
does.")
(defvar org-mu4e--internal-message-mode-function
(symbol-function 'mu4e-compose-mode)
"The `message-mode' (or derived mode) used by `org-mu4e-compose-mode'.")
(defun org-mu4e--override-org-mode-check-advice (oldfun &rest r)
"Around advice for various org mode functions.
This function will call OLDFUN with arguments R with `major-mode' let-bound to
\\='org-mode when `org-mu4e--override-org-mode-check' is t."
(let ((major-mode (if org-mu4e--override-org-mode-check
'org-mode
major-mode)))
(apply oldfun r)))
(advice-add 'org-element-at-point :around
'org-mu4e--override-org-mode-check-advice)
(defun org-mu4e-toggle-htmlize-mssage (&optional arg no-message)
"Toggle weather the current message should be htmlized.
If ARG is a positive number or zero, enable htmlization, if it is negative,
disable it. Otherwise, toggle it. With NO-MESSAGE, don't display a message
about this change."
(interactive "P")
(setq org-mu4e--html-message-p (or (wholenump arg)
(and (not arg)
(not org-mu4e--html-message-p))))
(unless no-message
(message "Message will be %ssent with an HTML part."
(if org-mu4e--html-message-p "" "not ")))
(force-mode-line-update))
(defun org-mu4e--bounds-of-mime-part (type)
"Find the bounds of the mime part for TYPE in the current buffer."
(save-excursion
(goto-char (point-min))
(when (and
(re-search-forward (rx bol (literal mail-header-separator) eol)
nil t)
(re-search-forward (rx "<#multipart" (* any) ">")
nil t)
(re-search-forward (rx "<#part " (* any)
"type=" (literal type) (* any) ">")
nil t))
(let ((start (match-end 0))
(end (point-max)))
(when (re-search-forward
(rx (or (and "<#/" (or "part" "multipart") ">")
(and "<#part" (* any) ">")))
nil t)
(setq end (match-beginning 0)))
(cons (1+ start) end)))))
(defun org-mu4e--pretty-print-fontify-html-part ()
"Pretty print and fontify the HTML part of the current buffer."
(when-let ((bounds (org-mu4e--bounds-of-mime-part "text/html"))
(real-buf (current-buffer)))
(save-excursion
(let ((content
(with-temp-buffer
(insert-buffer-substring real-buf (car bounds) (cdr bounds))
(let (sgml-mode-hook html-mode-hook text-mode-hook)
(html-mode))
(sgml-pretty-print (point-min) (point-max))
(indent-region (point-min) (point-max))
(put-text-property (point-min) (point-max) 'fontified nil)
(font-lock-ensure)
(buffer-string))))
(delete-region (car bounds) (cdr bounds))
(goto-char (car bounds))
(insert content)))))
(defun org-mu4e--htmlize-and-cleanup ()
"HTMLize and cleanup the visible portion of the buffer.
This moves point, wrap it in `save-excursion' if that is a problem."
(org-mime-htmlize)
;; IDK why, but the above function adds a bunch of newlines to the end
;; of the buffer.
(goto-char (point-min))
(when (re-search-forward (rx (group (* "\n")) "\n" eos) nil t)
(delete-region (match-beginning 1)
(match-end 1)))
(font-lock-ensure)
(org-mu4e--pretty-print-fontify-html-part))
(defun org-mu4e-preview-html ()
"Preview the HTML version of the current buffer in a new buffer.
Return the newly created buffer."
(interactive)
(let ((msg-buffer (current-buffer))
(buffer (get-buffer-create "*Org-Mu4e HTML Preview*"))
(bounds (point-min))
(cur-max (point-max)))
(without-restriction
(with-current-buffer buffer
(special-mode)
(setq-local org-mu4e--override-org-mode-check t)
;; Setup font-lock without all the other pesky major mode stuff
(org-set-font-lock-defaults)
(font-lock-add-keywords nil message-font-lock-keywords)
(let ((inhibit-read-only t))
(erase-buffer)
(insert-buffer-substring msg-buffer)
(narrow-to-region bounds cur-max)
(org-mu4e--htmlize-and-cleanup))
(goto-char (point-min))))
(switch-to-buffer-other-window buffer)
buffer))
(defun org-mu4e-render-preview ()
"Render a preview of the HTML message."
(interactive)
(let ((msg-buffer (current-buffer))
(buffer (get-buffer-create "*Org-Mu4e Render Preview*")))
(save-excursion
(without-restriction
(goto-char (point-min))
(if (re-search-forward (rx bol (literal mail-header-separator) eol)
nil t)
(let* ((start (1+ (match-end 0)))
(org-export-with-latex org-mime-org-html-with-latex-default)
(org-preview-latex-image-directory
(expand-file-name "ltximg/" mm-tmp-directory))
(default-directory org-preview-latex-image-directory)
(org-html-postamble nil))
(narrow-to-region start (point-max))
(if-let ((export-data (org-export-as
'html nil t nil
org-mime-export-options)))
(progn
(with-current-buffer buffer
(special-mode)
(let ((inhibit-read-only t)
(default-directory
org-preview-latex-image-directory))
(erase-buffer)
(insert export-data)
(shr-render-region (point-min) (point-max))
;; The above function inserts a text directionality
;; character and then two newlines, just to be safe,
;; check for them, then hide them
(goto-char (point-min))
(let ((new-start (point-min)))
(when (or (eq (char-after) #x200e)
(eq (char-after) #x200f))
(cl-incf new-start))
(dotimes (_ 2)
(forward-char)
(when (eq (char-after) ?\n)
(cl-incf new-start)))
(narrow-to-region new-start (point-max)))))
(switch-to-buffer-other-window buffer))
(user-error "HTML export failed")))
(user-error "Can't find message start in current buffer"))))))
(defun org-mu4e-send (&optional arg)
"HTMLize and send the message in the current buffer.
ARG is passed directly to `message-send'."
;; This has to return a non-nil value so that org knows we handled the C-c C-c
(interactive "P")
(let ((modified (buffer-modified-p))
;; we only restore the restriction if the sending below fails
(old-rest (cons (point-min) (point-max))))
(widen)
(let ((save-text (buffer-substring-no-properties (point-min)
(point-max))))
(condition-case _
(progn
(when org-mu4e--html-message-p
(org-mu4e--htmlize-and-cleanup))
(message-send arg)
'sent)
((or error quit)
(erase-buffer)
(insert save-text)
(narrow-to-region (car old-rest) (cdr old-rest))
(restore-buffer-modified-p modified)
'failed)))))
(defun org-mu4e-send-and-exit (&optional arg)
"Call `org-mu4e-send', the save and kill the buffer.
ARG is passed directly to `message-send'."
(interactive "P")
(when (eq (org-mu4e-send arg) 'sent)
(message-kill-buffer))
t ;; this tells org that we have handled the C-c C-c
)
;;;###autoload
(defun org-mu4e-compose-new (&rest r)
"This is like `mu4e-compose-new', but it utilizes `org-mu4e-compose-mode'.
Each of the arguments in R are the same as `mu4e-compose-new', and are directly
passed to it."
(interactive)
;; Save local variables set by `mu4e-compose-new'
(let ((org-mu4e--internal-message-mode-function
(symbol-function 'mu4e-compose-mode)))
(cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
(apply 'mu4e-compose-new r))))
;;;###autoload
(defvar-keymap org-mu4e-compose-mode-map
:parent org-mode-map
;; These come straight from `message-mode-map' and override `org-mode-map'
"C-c C-f C-t" #'message-goto-to
"C-c C-f C-o" #'message-goto-from
"C-c C-f C-b" #'message-goto-bcc
"C-c C-f C-w" #'message-goto-fcc
"C-c C-f C-c" #'message-goto-cc
"C-c C-f C-s" #'message-goto-subject
"C-c C-f C-r" #'message-goto-reply-to
"C-c C-f C-d" #'message-goto-distribution
"C-c C-f C-f" #'message-goto-followup-to
"C-c C-f C-m" #'message-goto-mail-followup-to
"C-c C-f C-k" #'message-goto-keywords
"C-c C-f C-u" #'message-goto-summary
"C-c C-f C-i" #'message-insert-or-toggle-importance
"C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
;; modify headers (and insert notes in body)
"C-c C-f s" #'message-change-subject
;;
"C-c C-f x" #'message-cross-post-followup-to
;; prefix+message-cross-post-followup-to = same without cross-post
"C-c C-f t" #'message-reduce-to-to-cc
"C-c C-f a" #'message-add-archive-header
;; mark inserted text
"C-c M-m" #'message-mark-inserted-region
"C-c M-f" #'message-mark-insert-file
"C-c C-b" #'message-goto-body
"C-c C-i" #'message-goto-signature
"C-c C-t" #'message-insert-to
"C-c C-f w" #'message-insert-wide-reply
"C-c C-f C-e" #'message-insert-expires
"C-c M-u" #'message-insert-or-toggle-importance
"C-c M-n" #'message-insert-disposition-notification-to
"C-c C-y" #'message-yank-original
"C-c C-M-y" #'message-yank-buffer
"C-c C-S-q" #'message-fill-yanked-message
"C-c M-s" #'message-insert-signature
"C-c M-h" #'message-insert-headers
"C-c M-o" #'message-sort-headers
;; C-c C-c to send and exit is handled by `org-ctrl-c-ctrl-c-hook'
"C-c C-s" #'org-mu4e-send
"C-c C-k" #'message-kill-buffer
"C-c C-d" #'message-dont-send
"C-c M-k" #'message-kill-address
"C-c M-e" #'message-elide-region
"C-c M-v" #'message-delete-not-region
"C-c M-z" #'message-kill-to-signature
"<remap> <split-line>" #'message-split-line
"<remap> <beginning-of-buffer>" #'mu4e-compose-goto-top
"<remap> <end-of-buffer>" #'mu4e-compose-goto-bottom
"C-c M-r" #'message-insert-screenshot
"M-n" #'message-display-abbrev
"C-c M-t" #'org-mu4e-toggle-htmlize-mssage
"C-c M-p C-p" #'org-mu4e-preview-html
"C-c M-p C-w" #'org-mu4e-render-preview
"C-c C-;" #'mu4e-compose-context-switch)
(defun org-mu4e--compose-mode-command-predicate (symbol buffer)
"`org-mu4e-compose-mode' local value for command completion predicate.
This will defer to the user's global value for the same, except that it allows
for commands who are designed for `message-mode' and `mu4e-mode' as well.
SYMBOL is the command to check. BUFFER is the buffer in which checking
happens. BUFFER is ignored."
(let ((real-fun (default-value 'read-extended-command-predicate))
(modes (command-modes symbol)))
(or (not real-fun)
(member 'message-mode modes)
(member 'mu4e-compose-mode modes)
(funcall real-fun symbol buffer))))
;;;###autoload
(define-derived-mode org-mu4e-compose-mode org-mode "mu4e:org-compose"
"Major mode for editing mu4e messages with `org-mode' syntax.
This is derived from `org-mode', but it also essentially runs
`mu4e-compose-mode' and `message-mode'. Therefore, it runs their hooks too."
;; Enable all the things from `mu4e-compose-mode' (which derives from
;; `message-mode'), but don't let it change the major mode (or other things we
;; care about).
(when org-mu4e--internal-message-mode-function
(let ((major-mode major-mode)
(mode-name mode-name)
(local-abbrev-table local-abbrev-table)
(font-lock-defaults font-lock-defaults)
;; some of these are not actually changed, but they are here just in
;; case they change in the future...
(comment-start comment-start)
(comment-end comment-end)
(comment-start-skip comment-start-skip)
(comment-add comment-add)
(comment-style comment-style))
(cl-letf (((symbol-function 'kill-all-local-variables) 'ignore)
((symbol-function 'use-local-map) 'ignore)
((symbol-function 'set-syntax-table) 'ignore))
(funcall org-mu4e--internal-message-mode-function))))
;; Add `message-mode' keyword and quote highlighting on top of the org syntax
;; highlighting
(font-lock-add-keywords nil message-font-lock-keywords)
(setq-local org-mu4e--override-org-mode-check t
;; This does not work, but I am leaving it here to figure out later
read-extended-command-predicate
'org-mu4e--compose-mode-command-predicate)
(add-to-list (make-local-variable 'org-ctrl-c-ctrl-c-final-hook)
'org-mu4e-send-and-exit)
(add-to-list (make-local-variable 'mode-line-misc-info)
'(:eval (if org-mu4e--html-message-p
"Text/HTML "
"Text Only "))))
;;;###autoload
(define-mail-user-agent 'org-mu4e-user-agent
#'org-mu4e-compose-new
#'org-mu4e-send-and-exit
#'message-kill-buffer
'message-send-hook)
;;;###autoload
(defun org-mu4e-user-agent ()
"Return `org-mu4e-user-agent'."
'org-mu4e-user-agent)
(provide 'org-mu4e-compose)
;;; org-mu4e-compose.el ends here