;;; rbbh.el --- Revert Buffer By Hunks -*- lexical-binding: t -*-

(require 'diff)

;; At least for now, this are defconst.

(defconst rbbh-diff-command "diff"
  "Name of the command to run diff")

(defconst rbbh-diff-switches "--normal"
  "Switches to pass to diff.")

(defconst rbbh-diff-change-command-regexp
  (let ((rng "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
    (concat "^" rng "\\([acd]\\)" rng "$"))
  "Regular expression that matches the change commands for each hunk
Should be in synch with the switch used to call diff.")

(defconst rbbh-diff-buffer-name "*RBBH-Diff*"
  "The name of the diff buffer internally created by `rbbh--run-diff'.")

(defvar rbbh-current-diff-buffer-name nil
  "Name of the current diff buffer.")

(defvar rbbh-total-hunks 0
  "Total hunks in the diff output.")

;; If `diff' and `diff-mode' are not to be required, this function should be
;; changed to do a lot of what `diff-no-select' does.
(defun rbbh--run-diff (buf)
  "Compare contents of buffer BUF with those of the file it visits.
Runs `rbbh-diff-command' command to make the comparison, and puts its output
in a buffer, with basename `rbbh-diff-buffer-name'.
The command is run with the switches `rbbh-diff-switches'."
  (let ((diff-command rbbh-diff-command)
	(diff-use-labels nil)) ; Don't care about labels.
    (setq rbbh-current-diff-buffer-name (generate-new-buffer
					 rbbh-diff-buffer-name))
    (with-current-buffer buf
      (diff-no-select buf buffer-file-name rbbh-diff-switches
		      t rbbh-current-diff-buffer-name))))

;; With this, reverted hunks can be undone one by one.
(defsubst rbbh--split-undo-hunk (buf)
  "Force undo history to separate hunk replacements in buffer BUF."
  (with-current-buffer buf
    (undo-boundary)))

(defun rbbh-delete-line (&optional arg)
  "Delete ARG lines (or the current line, if ARG is 0).
Does not put the killed text in the `kill-ring'.  See `kill-whole-line' for
details on ARG."
  (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))))
        (t
         (delete-region (progn (forward-visible-line 0) (point))
			(progn (forward-visible-line arg) (point))))))

(defsubst rbbh-count-total-hunks (diff-buf &optional change-command-re)
  (with-current-buffer diff-buf
    (save-excursion
      (goto-char (point-min))
      (let ((count 0)
	    (re (or change-command-re rbbh-diff-change-command-regexp)))
	(while (re-search-forward re nil t)
	  (setq count (1+ count)))
	count))))

(defsubst rbbh-get-hunk-contents (beg end)
  "Get the hunk contents from positions BEG to END.
Expects that a diff buffer is the current buffer."
  (let ((start (point)))
    (forward-line (1+ (- beg end)))
    (let ((text (buffer-substring start (point))))
      ;; Remember that we are using the --normal switch, hence the > and <
      ;; replacement.
      (setq text (replace-regexp-in-string "^[><] " "" text))
      text)))

(defun rbbh-patch-buffer (buf diff-buf)
  "Patch the buffer BUF according to the contents of the diff buffer DIFF-BUF.
It works with a diff buffer that contains a --normal output from diff."
  ;; line-offset keeps memory of the lines added and deleted to the buffer BUF,
  ;; and it is necessary because the diff output will stay the same (line
  ;; references will stay relative to the unpatched buffer).
  ;; Added lines decrements offset, and deleted lines increment it.
  (let ((line-offset 0)
	(column (current-column))) ; To restore point just right.
    (save-excursion
      (with-current-buffer diff-buf
	(goto-char (point-min))
	(save-excursion
	  (while (re-search-forward rbbh-diff-change-command-regexp nil t)
	    (rbbh--split-undo-hunk buf)  ; Make each change of hunk undoable.
	    (forward-line) ; skip the command.
	    ;; Get ranges and the action, from the previous match.
	    (let* ((action-cmd (match-string 4))
		   (old-from (string-to-number (match-string 1)))
		   (old-to (if (match-beginning 3)
			       (string-to-number (match-string 3))
			     old-from))
		   (new-from (string-to-number (match-string 5)))
		   (new-to (if (match-beginning 7)
			       (string-to-number (match-string 7))
			     new-from)))
	      (cond ((equal action-cmd "a")
		     ;; When adding, we take the text and remove > and <
		     ;; (diff was called with --normal switch).
		     ;; Then navigate to the line, accounting the offset,
		     ;; and insert the text.
		     (let ((text (rbbh-get-hunk-contents new-to new-from)))
		       (with-current-buffer buf
			 (goto-char (point-min))
			 (forward-line (- old-from line-offset))
			 (setq line-offset (- line-offset (1+ (- new-to
								 new-from))))
			 (insert text))))
		    ((equal action-cmd "d")
		     ;; When deleting, navigate to the correct line and kill
		     ;; as many lines as the range in the diff output says.
		     (with-current-buffer buf
		       (goto-char (point-min))
		       (forward-line (1- (- old-from line-offset)))
		       (setq line-offset (+ line-offset (1+
							 (- old-to old-from))))
		       (rbbh-delete-line (1+ (- old-to old-from)))))
		    ((equal action-cmd "c")
		     ;; When changing, is a combination of adding and deleting.
		     ;; Get the text after "---", and act similar as we would
		     ;; with adding.
		     ;; But before, kill the lines, as we do when deleting.
		     (re-search-forward "^---")
		     (forward-line)
		     (let ((text (rbbh-get-hunk-contents new-to new-from)))
		       (with-current-buffer buf
			 (goto-char (point-min))
			 (forward-line (1- (- old-from line-offset)))
			 (rbbh-delete-line (1+ (- old-to old-from)))
			 (setq line-offset (+ line-offset (- old-to old-from)
					      new-from (- new-to)))
			 (insert text))))
		    (t
		     (error "Unknown command action in diff output"))))))))
    (move-to-column column))) ; Restore column.

;; Not sure if the function would be a good candidate for
;; `revert-buffer-function'.
;; But just in case, make it take _ignore-auto as an argument.
;; Note that reverting with the contents of an auto save file is not supported.
;; It could be added, if suggested.
(defun rbbh-revert-buffer-by-hunks (&optional _ignore-auto noconfirm)
  "Revert buffer by hunks, instead of doing a single deletion plus insertion.
This action is useful when you want to revert a buffer (like you would do with
`revert-buffer'), but then would like to undo some of the reverting.
When the buffer hasn't been modified, nothing is done.
This function is only useful for buffers visting files.
After reverting, it marks the buffer as not modified.

When NOCONFIRM is non-nil, don't ask for confirmation before reverting.  The
other way of avoiding the query is provided by the variable 
`revert-without-query'.  Nevertheless, you will be always prompted, if the
file was changed externally.

The optional argument _IGNORE-AUTO is ignored and is provided only for
compatibility with `revert-buffer'.  Thus, it is a candidate for the variable
`revert-buffer-function'."
  (interactive)
  (with-current-buffer (or (buffer-base-buffer (current-buffer))
			   (current-buffer))
    (save-excursion
      (let ((file-name buffer-file-name)
	    (buf (current-buffer))
	    ;; Just in case we are not the revert-buffer-function.
	    (revert-buffer-in-progress-p t))
	;; Repeat some of what revert-buffer--default does, because it is not
	;; sure reverting by hunks is a candidate for revert-buffer-function.
	(cond ((null file-name)
	       (error "Buffer does not seem to be associated with any file"))
	      ((or (and (not (verify-visited-file-modtime buf))
			(yes-or-no-p
			 (format "File %s was modified outside of Emacs.  Really revert?"
				 file-name)))
		   noconfirm
		   ;; Respect user choice.
		   (catch 'found
		     (dolist (regexp revert-without-query)
		       (when (string-match regexp file-name)
			 (throw 'found t))))
		   (yes-or-no-p (format "Revert buffer from file %s? "
					file-name)))
	       (run-hooks 'before-revert-hook)
	       (rbbh--run-diff buf)
	       (rbbh-patch-buffer buf rbbh-current-diff-buffer-name)
	       ;; Mark the buffer as not modified, like it would happen with
	       ;; the default behavior of revert-buffer.
	       (set-buffer-modified-p nil)
	       ;; Report to the user (this could be made optional).
	       (setq rbbh-total-hunks (rbbh-count-total-hunks
				       rbbh-current-diff-buffer-name))
	       (message "%d %s reverted" rbbh-total-hunks
			(if (= rbbh-total-hunks 1)
			    "hunk"
			  "hunks"))
	       ;; Kill the diff buffer we used.
	       (kill-buffer rbbh-current-diff-buffer-name)
	       (run-hooks 'after-revert-hook))
	      (t
	       (message "Revert aborted")))))))

(provide 'rbbh)

;;; rbbh.el ends here