refactor(format): replace with apheleia

Initial refactor of format module to replace format-all with apheleia
This commit is contained in:
Ellis Kenyő 2022-08-16 08:13:55 +01:00 committed by Ellis Kenyo
parent a44e8d6bfd
commit 4ecd616cd8
No known key found for this signature in database
GPG key ID: 298BE5D997EBAA02
9 changed files with 126 additions and 585 deletions

View file

@ -1,276 +1,85 @@
;;; editor/format/autoload.el -*- lexical-binding: t; -*-
(defvar +format-region-p nil
"Is non-nil if currently reformatting a selected region, rather than the whole
buffer.")
;;;###autoload
(autoload 'format-all--probe "format-all")
(defun +format--delete-whole-line (&optional arg)
"Delete the current line without putting it in the `kill-ring'.
Derived from function `kill-whole-line'. ARG is defined as for that
function.
Stolen shamelessly from go-mode"
(setq arg (or arg 1))
(if (and (> arg 0)
(eobp)
(save-excursion (forward-visible-line 0) (eobp)))
(signal 'end-of-buffer nil))
(if (and (< arg 0)
(bobp)
(save-excursion (end-of-visible-line) (bobp)))
(signal 'beginning-of-buffer nil))
(cond ((zerop arg)
(delete-region (progn (forward-visible-line 0) (point))
(progn (end-of-visible-line) (point))))
((< arg 0)
(delete-region (progn (end-of-visible-line) (point))
(progn (forward-visible-line (1+ arg))
(unless (bobp)
(backward-char))
(point))))
((delete-region (progn (forward-visible-line 0) (point))
(progn (forward-visible-line arg) (point))))))
;;;###autoload
(defun +format--apply-rcs-patch (patch-buffer)
"Apply an RCS-formatted diff from PATCH-BUFFER to the current buffer.
Stolen shamelessly from go-mode"
(let ((target-buffer (current-buffer))
;; Relative offset between buffer line numbers and line numbers
;; in patch.
;;
;; Line numbers in the patch are based on the source file, so
;; we have to keep an offset when making changes to the
;; buffer.
;;
;; Appending lines decrements the offset (possibly making it
;; negative), deleting lines increments it. This order
;; simplifies the forward-line invocations.
(line-offset 0)
(column (current-column)))
(save-excursion
(with-current-buffer patch-buffer
(goto-char (point-min))
(while (not (eobp))
(unless (looking-at "^\\([ad]\\)\\([0-9]+\\) \\([0-9]+\\)")
(error "Invalid rcs patch or internal error in +format--apply-rcs-patch"))
(forward-line)
(let ((action (match-string 1))
(from (string-to-number (match-string 2)))
(len (string-to-number (match-string 3))))
(cond
((equal action "a")
(let ((start (point)))
(forward-line len)
(let ((text (buffer-substring start (point))))
(with-current-buffer target-buffer
(cl-decf line-offset len)
(goto-char (point-min))
(forward-line (- from len line-offset))
(insert text)))))
((equal action "d")
(with-current-buffer target-buffer
(goto-char (point-min))
(forward-line (1- (- from line-offset)))
(cl-incf line-offset len)
(+format--delete-whole-line len)))
((error "Invalid rcs patch or internal error in +format--apply-rcs-patch")))))))
(move-to-column column)))
(defun +format--current-indentation ()
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t\n")
(current-indentation)))
;;
;; Public library
(defun +format-completing-read ()
"TODO"
(require 'format-all)
(let* ((fmtlist (mapcar #'symbol-name (hash-table-keys format-all--format-table)))
(fmt (completing-read "Formatter: " fmtlist)))
(if fmt (intern fmt))))
;;;###autoload
(defun +format-probe-a (fn)
"Use `+format-with' instead, if it is set.
Prompts for a formatter if universal arg is set."
(cond ((or buffer-read-only (eq +format-with :none))
(list nil nil))
(current-prefix-arg
(list (or (+format-completing-read)
(user-error "Aborted"))
t))
(+format-with
(list +format-with t))
((and +format-with-lsp
(bound-and-true-p lsp-managed-mode)
(lsp-feature? "textDocument/formatting"))
(list 'lsp nil))
((and +format-with-lsp
(bound-and-true-p eglot--managed-mode)
(eglot--server-capable :documentFormattingProvider))
(list 'eglot nil))
((funcall fn))))
;;;###autoload
(defun +format-buffer-a (formatter mode-result)
"Advice that extends `format-all-buffer--with' to:
1. Enable partial/region reformatting, while preserving leading indentation,
2. Applies changes via RCS patch, line by line, to protect buffer markers and
reduce cursor movement or window scrolling.
See `+format/buffer' for the interactive version of this function, and
`+format-buffer-h' to use as a `before-save-hook' hook."
(cond
((eq formatter 'lsp)
(call-interactively
(if +format-region-p #'lsp-format-region #'lsp-format-buffer)))
((eq formatter 'eglot)
(call-interactively
(if +format-region-p #'eglot-format #'eglot-format-buffer)))
((let ((f-function (gethash formatter format-all--format-table))
(executable (format-all--formatter-executable formatter))
(indent 0)
(old-line-number (line-number-at-pos))
(old-column (current-column)))
(pcase-let*
((`(,output ,errput)
;; To reliably format regions, rather than the whole buffer, and
;; `format-all' (and various formatting functions, like `gofmt') widen
;; the buffer, we must copy the region first.
(let ((output (buffer-substring-no-properties (point-min) (point-max)))
(origin-buffer (or (buffer-base-buffer) (current-buffer)))
;; Fixes #5133: some packages (like lsp-mode) can do a bunch
;; of complicated stuff in these hooks. Better to not have to
;; deal with any of them at all.
write-file-functions
before-save-hook
after-save-hook
kill-buffer-query-functions
kill-buffer-hook)
(with-temp-buffer
(with-silent-modifications
(insert output)
;; Ensure this temp buffer seems as much like the origin
;; buffer as possible, in case the formatter is an elisp
;; function, like `gofmt'.
(cl-loop for (var . val)
in (cl-remove-if-not #'listp (buffer-local-variables origin-buffer))
;; Making enable-multibyte-characters buffer-local
;; causes an error.
unless (eq var 'enable-multibyte-characters)
;; Fixes #5133: don't deal with complicated hook
;; functionality! This isn't a real buffer anyway.
unless (string-match-p (symbol-name var) "-\\(hook\\|functions\\)$")
;; Using setq-local would quote var.
do (set (make-local-variable var) val))
;; Since we're piping a region of text to the formatter, remove
;; any leading indentation to make it look like a file.
(setq indent (+format--current-indentation))
(when (> indent 0)
(indent-rigidly (point-min) (point-max) (- indent)))
(funcall f-function executable mode-result)))))
(`,status
(cond ((null output) :error)
((eq output t) :already-formatted)
(t :reformatted))))
(unwind-protect
(when (eq status :reformatted)
(let ((tmpfile (make-temp-file "doom-format"))
(patchbuf (get-buffer-create " *doom format patch*"))
(coding-system-for-read coding-system-for-read)
(coding-system-for-write coding-system-for-write))
(unless IS-WINDOWS
(setq coding-system-for-read 'utf-8
coding-system-for-write 'utf-8))
(unwind-protect
(progn
(with-current-buffer patchbuf
(erase-buffer))
(with-temp-file tmpfile
(erase-buffer)
(insert output)
(when (> indent 0)
;; restore indentation without affecting new
;; indentation
(indent-rigidly (point-min) (point-max)
(max 0 (- indent (+format--current-indentation))))))
(if (zerop (call-process-region (point-min) (point-max) "diff" nil patchbuf nil "-n" "-" tmpfile))
(setq status :already-formatted)
(+format--apply-rcs-patch patchbuf)
(list output errput)))
(kill-buffer patchbuf)
(delete-file tmpfile))))
(format-all--show-or-hide-errors errput)
(goto-char (point-min))
(forward-line (1- old-line-number))
(let ((line-length (- (point-at-eol) (point-at-bol))))
(goto-char (+ (point) (min old-column line-length))))
(run-hook-with-args 'format-all-after-format-functions formatter status)
(message (pcase status
(:error "Formatting error")
(:already-formatted "Already formatted")
(:reformatted (format "Reformatted with %s" formatter))))))))))
(defun +format-region (start end &optional callback)
"Format from START to END with `apheleia'."
(when-let* ((command (apheleia--get-formatter-command
(if current-prefix-arg
'prompt
'interactive)))
(cur-buffer (current-buffer))
(formatted-buffer (get-buffer-create " *apheleia-formatted*"))
(indent 0))
(with-current-buffer formatted-buffer
(erase-buffer)
(unless IS-WINDOWS
(setq-local coding-system-for-read 'utf-8)
(setq-local coding-system-for-write 'utf-8))
;; Ensure this temp buffer seems as much like the origin buffer as
;; possible, in case the formatter is an elisp function, like `gofmt'.
(cl-loop for (var . val)
in (cl-remove-if-not #'listp (buffer-local-variables origin-buffer))
;; Making enable-multibyte-characters buffer-local causes an
;; error.
unless (eq var 'enable-multibyte-characters)
;; Using setq-local would quote var.
do (set (make-local-variable var) val))
;;
(insert-buffer-substring-no-properties cur-buffer start end)
;; Since we're piping a region of text to the formatter, remove any
;; leading indentation to make it look like a file.
(setq indent (+format--current-indentation))
(when (> indent 0)
(indent-rigidly (point-min) (point-max) (- indent)))
;;
(apheleia-format-buffer
command
(lambda ()
(with-current-buffer formatted-buffer
(when (> indent 0)
;; restore indentation without affecting new
;; indentation
(indent-rigidly (point-min) (point-max)
(max 0 (- indent (+format--current-indentation))))))
(with-current-buffer cur-buffer
(delete-region start end)
(insert-buffer-substring-no-properties formatted-buffer)
(when callback (funcall callback))
(kill-buffer formatted-buffer)))))))
;;
;;; Commands
(defun +format--org-region (beg end)
"Reformat the region within BEG and END.
If nil, BEG and/or END will default to the boundaries of the src block at point."
(let ((element (org-element-at-point)))
(save-excursion
(let* ((block-beg (save-excursion
(goto-char (org-babel-where-is-src-block-head element))
(line-beginning-position 2)))
(block-end (save-excursion
(goto-char (org-element-property :end element))
(skip-chars-backward " \t\n")
(line-beginning-position)))
(beg (if beg (max beg block-beg) block-beg))
(end (if end (min end block-end) block-end))
(lang (org-element-property :language element))
(major-mode (org-src-get-lang-mode lang)))
(if (eq major-mode 'org-mode)
(user-error "Cannot reformat an org src block in org-mode")
(+format/region beg end))))))
(defun +format--buffer ()
(if (and (eq major-mode 'org-mode)
(org-in-src-block-p t))
(+format--org-region (point-min) (point-max))
(if (called-interactively-p 'any)
(format-all-buffer)
(ignore-errors (format-all-buffer)))))
;;;###autoload
(defun +format/buffer ()
(defun +format/buffer (&optional arg)
"Reformat the current buffer using LSP or `format-all-buffer'."
(interactive)
(+format--buffer))
(interactive "P")
(call-interactively
(if (and +format-with-lsp
(bound-and-true-p lsp-mode)
(lsp-feature? "textDocument/formatting"))
#'lsp-format-buffer
#'apheleia-format-buffer)))
;;;###autoload
(defun +format/region (beg end)
(defun +format/region (beg end &optional arg)
"Runs the active formatter on the lines within BEG and END.
WARNING: this may not work everywhere. It will throw errors if the region
contains a syntax error in isolation. It is mostly useful for formatting
snippets or single lines."
(interactive "rP")
(let ((+format-region-p t))
(save-restriction
(narrow-to-region beg end)
(+format--buffer))))
(if (and +format-with-lsp
(bound-and-true-p lsp-mode)
(lsp-feature? "textDocument/rangeFormatting"))
(call-interactively #'lsp-format-region)
(+format-region beg end)))
;;;###autoload
(defun +format/region-or-buffer ()
@ -281,13 +90,3 @@ is selected)."
(if (doom-region-active-p)
#'+format/region
#'+format/buffer)))
;;
;; Hooks
;;;###autoload
(defalias '+format-buffer-h #'+format/buffer
"Format the source code in the current buffer with minimal feedback.
Meant for `before-save-hook'.")

View file

@ -1,97 +1,11 @@
;;; editor/format/autoload/settings.el -*- lexical-binding: t; -*-
;; This must be redefined here because `format-all' only makes it available at
;; compile time.
(defconst +format-system-type
(cl-case system-type
(windows-nt 'windows)
(cygwin 'windows)
(darwin 'macos)
(gnu/linux 'linux)
(berkeley-unix
(save-match-data
(let ((case-fold-search t))
(cond ((string-match "freebsd" system-configuration) 'freebsd)
((string-match "openbsd" system-configuration) 'openbsd)
((string-match "netbsd" system-configuration) 'netbsd))))))
"Current operating system according to the format-all package.")
(defun +format--resolve-system (choices)
"Get first choice matching `format-all-system-type' from CHOICES."
(cl-loop for choice in choices
if (atom choice) return choice
else if (eql +format-system-type (car choice))
return (cadr choice)))
(defun +format--make-command (formatter &rest _)
`(format-all--buffer-thunk
(lambda (input)
(with-silent-modifications
(setq buffer-file-name ,(buffer-file-name (buffer-base-buffer))
default-directory ,default-directory)
(delay-mode-hooks (funcall ',major-mode))
(insert input)
(condition-case e
(progn
(doom-log "formatter (commandp) %s" #',formatter)
(call-interactively #',formatter)
(list nil ""))
(error (list t (error-message-string e))))))))
(defun +format--make-function (formatter &rest _)
`(progn
(doom-log "formatter (functionp) %s" #',formatter)
(format-all--buffer-thunk #',formatter)))
(defun +format--make-shell-command (command ok-statuses error-regexp)
(+format--make-shell-command-list (split-string command " " t)
ok-statuses error-regexp))
(defun +format--make-shell-command-list (command-list ok-statuses error-regexp)
`(let (args)
(dolist (arg ',command-list)
(cond ((stringp arg)
(push arg args))
((listp arg)
(catch 'skip
(let (subargs this)
(while (setq this (pop arg))
(cond ((not (stringp (car arg)))
(let ((val (eval (pop arg) t)))
(unless val (throw 'skip nil))
(push (format this val) subargs)))
((stringp this)
(push this subargs))))
(setq args (append subargs args)))))))
(doom-log "formatter (arglist) %s" args)
(if ,(and (or ok-statuses error-regexp) t)
(apply #'format-all--buffer-hard
',ok-statuses ,error-regexp nil
(reverse args))
(apply #'format-all--buffer-easy (reverse args)))))
(cl-defun +format--set (name &key function modes unset)
(declare (indent defun))
(when (and unset (not (gethash name format-all--format-table)))
(error "'%s' formatter does not exist to be unset" name))
(puthash name function format-all--format-table)
(dolist (mode (ensure-list modes))
(cl-destructuring-bind (m &optional probe)
(ensure-list mode)
(if unset
(puthash m (assq-delete-all name (gethash key format-all-mode-table))
format-all-mode-table)
(format-all--pushhash
m (cons name (if probe `(lambda () ,probe)))
format-all--mode-table)))))
;;;###autodef
(cl-defun set-formatter!
(name formatter &key modes filter ok-statuses error-regexp)
(name &rest args &key modes filter &allow-other-keys)
"Define (or modify) a formatter named NAME.
Supported keywords: :modes :filter :ok-statuses :error-regexp
Supported keywords: :modes :filter
NAME is a symbol that identifies this formatter.
@ -99,7 +13,7 @@ FORMATTER can be a symbol referring to another formatter, a function, string or
nested list.
If a function, it should be a formatter function that
`format-all--buffer-thunk' will accept.
`apheleia--run-formatter-function' will accept.
If a string, it is assumed to be a shell command that the buffer's text will
be piped to (through stdin).
If a list, it should represent a shell command as a list of arguments. Each
@ -107,6 +21,9 @@ nested list.
string and ARG is both a predicate and argument for STRING. If ARG is nil,
STRING will be omitted from the vector.
For more information on how to structure the list to be
compatible, see `apheleia--run-formatter-function'.
MODES is a major mode, a list thereof, or a list of two-element sublists with
the structure: (MAJOR-MODE FORM). FORM is evaluated when the buffer is formatted
and its return value serves two purposes:
@ -116,27 +33,12 @@ and its return value serves two purposes:
2. It's return value is made available to FORMATTER if it is a function or
list of shell arguments via the `mode-result' variable.
FILTER is a function that takes three arguments: the formatted output, any error
output and the position of the first change. This function must return these
three after making whatever changes you like to them. This might be useful if
the output contains ANSI color codes that need to be stripped out (as is the
case with elm-format).
OK-STATUSES and ERROR-REGEXP are ignored if FORMATTER is not a shell command.
OK-STATUSES is a list of integer exit codes that should be treated as success
codes. However, if ERROR-REGEXP is given, and the program's stderr contains that
regexp, then the formatting is considered failed even if the exit status is in
OK-STATUSES.
Basic examples:
(set-formatter! 'asmfmt \"asmfmt\" :modes '(asm-mode nasm-mode))
(set-formatter! 'black \"black -q -\")
(set-formatter! 'html-tidy \"tidy -q -indent\" :modes '(html-mode web-mode))
Advanced examples:
(set-formatter!
'clang-format
'(\"clang-format\"
@ -154,9 +56,7 @@ Advanced examples:
:modes
'(html-mode
(web-mode (and (equal \"none\" web-mode-engine)
(car (member web-mode-content-type '(\"xml\" \"html\"))))))
:ok-statuses '(0 1)
:executable \"tidy\")
(car (member web-mode-content-type '(\"xml\" \"html\")))))))
(set-formatter! 'html-tidy ; overwrite predefined html-tidy formatter
'(\"tidy\" \"-q\" \"-indent\"
@ -165,39 +65,22 @@ Advanced examples:
\"--show-body-only\" \"auto\"
(\"--indent-spaces\" \"%d\" tab-width)
(\"--indent-with-tabs\" \"%s\" (if indent-tabs-mode \"yes\" \"no\"))
(\"-xml\" (memq major-mode '(nxml-mode xml-mode))))
:ok-statuses '(0 1)))
(\"-xml\" (memq major-mode '(nxml-mode xml-mode)))))
(set-formatter! 'elm-format
\"elm-format --yes --stdin\"
:filter
(lambda (output errput first-diff)
(list output
(format-all--remove-ansi-color errput)
first-diff)))"
\"elm-format --yes --stdin\")
"
(declare (indent defun))
(cl-check-type name symbol)
(after! format-all
(if (null formatter)
(+format--set name
:unset t
:modes modes)
(let ((fn (funcall (cond ((stringp formatter)
#'+format--make-shell-command)
((listp formatter)
#'+format--make-shell-command-list)
((and (commandp formatter)
(not (stringp formatter)))
#'+format--make-command)
((functionp formatter)
#'+format--make-function))
formatter
ok-statuses
error-regexp)))
(cl-check-type filter (or function null))
(+format--set name
:function
`(lambda (executable mode-result)
,(if filter `(apply #',filter ,fn) fn))
:modes modes)
name))))
(after! apheleia
(if (null args)
(progn
(setq apheleia-formatters
(assq-delete-all name apheleia-formatters))
(while (rassoc name apheleia-mode-alist)
(setq apheleia-mode-alist
(assq-delete-all (car (rassoc name apheleia-mode-alist)) apheleia-mode-alist))))
(setf (alist-get name apheleia-formatters) args)
(when modes
(dolist (mode modes)
(setf (alist-get mode apheleia-mode-alist) name))))))