Function: apheleia--apply-rcs-patch
apheleia--apply-rcs-patch is a natively compiled function defined in
apheleia-rcs.el.
Signature
(apheleia--apply-rcs-patch CONTENT-BUFFER PATCH-BUFFER)
Documentation
Apply RCS patch.
CONTENT-BUFFER contains the text to be patched, and PATCH-BUFFER contains the patch.
Source Code
;; Defined in /nix/store/lwcwryzabcmvjcwwzzs65jrwf7p7d7cs-emacs-packages-deps/share/emacs/site-lisp/elpa/apheleia-20260915.1628/apheleia-rcs.el
(defun apheleia--apply-rcs-patch (content-buffer patch-buffer)
"Apply RCS patch.
CONTENT-BUFFER contains the text to be patched, and PATCH-BUFFER
contains the patch."
(apheleia--log
'rcs "Applying RCS patch from %S to %S" patch-buffer content-buffer)
(let ((commands nil)
(pos-list nil)
(window-line-list nil))
(with-current-buffer content-buffer
(push `(:type point :pos ,(point)) pos-list)
(when (marker-position (mark-marker))
(push `(:type marker :pos ,(mark-marker)) pos-list))
(dolist (m mark-ring)
(when (marker-position m)
(push `(:type marker :pos ,m) pos-list)))
(dolist (w (get-buffer-window-list nil nil t))
(push
`(:type window-point :pos ,(window-point w) :window ,w) pos-list)
(push (list w (count-lines (window-start w) (point))
(- (line-number-at-pos (point))
(line-number-at-pos (window-start w)))
(copy-marker (window-start w)))
window-line-list)))
(with-current-buffer patch-buffer
(apheleia--map-rcs-patch
(lambda (command)
(with-current-buffer content-buffer
;; Could be optimized significantly by moving only as many
;; lines as needed, rather than returning to the beginning
;; of the buffer first.
(save-excursion
(goto-char (point-min))
(forward-line (1- (alist-get 'start command)))
;; Account for the off-by-one error in the RCS patch spec
;; (namely, text is added *after* the line mentioned in
;; the patch).
(when (and (eq (alist-get 'command command) 'addition)
(> (alist-get 'start command) 0))
(forward-line))
(push `(marker . ,(point-marker)) command)
(push command commands)
;; If we delete a region just before inserting new text
;; at the same place, then it is a replacement. In this
;; case, check if the replaced region includes the window
;; point for any window currently displaying the content
;; buffer. If so, figure out where that window point
;; should be moved to, and record the information in an
;; additional command.
;;
;; See <https://www.gnu.org/software/emacs/manual/html_node/elisp/Window-Point.html>.
;;
;; Note that the commands get pushed in reverse order
;; because of how linked lists work.
(let ((deletion (nth 1 commands))
(addition (nth 0 commands)))
(when (and (eq (alist-get 'command deletion) 'deletion)
(eq (alist-get 'command addition) 'addition)
;; Again with the weird off-by-one
;; computations. For example, if you replace
;; lines 68 through 71 inclusive, then the
;; deletion is for line 68 and the addition
;; is for line 70. Blame RCS.
(= (+ (alist-get 'start deletion)
(alist-get 'lines deletion)
-1)
(alist-get 'start addition)))
(let ((text-start (alist-get 'marker deletion)))
(goto-char text-start)
(forward-line (alist-get 'lines deletion))
(let ((text-end (point)))
(dolist (pos-spec pos-list)
(let ((p (plist-get pos-spec :pos)))
;; Check if the point, or marker, or window
;; point, is within the replaced region.
;; Markers pretend to be numbers, so we can
;; run this in any of the three cases.
(when (and (< text-start p)
(< p text-end))
(let* ((old-text (buffer-substring-no-properties
text-start text-end))
(new-text (alist-get 'text addition))
(old-relative-point (- p text-start))
(new-relative-point
(if (> (max (length old-text)
(length new-text))
apheleia-max-alignment-size)
old-relative-point
(apheleia--align-point
old-text new-text old-relative-point))))
(goto-char text-start)
(push
`((command . move-cursor)
(cursor . ,pos-spec)
(offset . ,(- new-relative-point
old-relative-point)))
commands))))))))))))))
(with-current-buffer content-buffer
;; We run both `goto-char' and `set-window-point' to offset
;; point and window point, don't want to chance that both
;; changes will stack on top of each other.
(let ((orig-point (point)))
(dolist (command (nreverse commands))
(pcase (alist-get 'command command)
(`addition
(save-excursion
(goto-char (alist-get 'marker command))
(insert (alist-get 'text command))))
(`deletion
(save-excursion
(goto-char (alist-get 'marker command))
(forward-line (alist-get 'lines command))
(delete-region (alist-get 'marker command) (point))))
(`move-cursor
(let ((cursor (alist-get 'cursor command))
(offset (alist-get 'offset command)))
(pcase (plist-get cursor :type)
(`point
(goto-char
(+ orig-point offset)))
(`marker
(set-marker
(plist-get cursor :pos)
(+ (plist-get cursor :pos) offset)))
(`window-point
(set-window-point
(plist-get cursor :window)
(+ orig-point offset))))))))))
;; Restore the scroll position of each window displaying the
;; buffer.
(dolist (entry window-line-list)
(cl-destructuring-bind
(w old-window-line old-window-line-distance old-window-start) entry
(let ((new-window-line
(count-lines (window-start w) (point)))
(new-window-line-distance
(- (line-number-at-pos (point))
(line-number-at-pos old-window-start))))
(with-selected-window w
;; Sometimes if the text is less than a buffer long, and
;; we do a deletion, it might not be possible to keep the
;; vertical position of point the same by scrolling.
;; That's okay. We just go as far as we can.
(ignore-errors
(if (= old-window-line-distance new-window-line-distance)
(set-window-start w old-window-start)
(scroll-down (- old-window-line new-window-line)))))
(set-marker old-window-start nil))))))