;;; diff-at-point.el --- Diff navigation -*- lexical-binding: t -*-

;; SPDX-License-Identifier: GPL-2.0-or-later
;; Copyright (C) 2019  Campbell Barton

;; Author: Campbell Barton <ideasman42@gmail.com>

;; URL: https://codeberg.org/ideasman42/emacs-diff-at-point
;; Package-Version: 20260813.359
;; Package-Revision: 5cdfc8fdefc9
;; Package-Requires: ((emacs "29.1"))

;;; Commentary:

;; Open a diff, navigating to the current file, line and column.

;;; Usage:

;; ;; Run from a diff buffer.
;; (diff-at-point-goto-source-and-close)
;;
;; ;; Create a diff on the repository, navigate to the current point.
;; (diff-at-point-open-and-goto-hunk)

;;; Code:

;; ---------------------------------------------------------------------------
;; Require Dependencies

;; Needed for calling 'diff-goto-source'.
(require 'diff-mode)

(declare-function vc-root-diff "vc" (&optional historic not-essential))


;; ---------------------------------------------------------------------------
;; Compatibility

(eval-when-compile
  (when (version< emacs-version "31.1")
    (defmacro incf (place &optional delta)
      "Increment PLACE by DELTA or 1."
      (declare (debug (gv-place &optional form)))
      (gv-letplace (getter setter) place
        (funcall setter `(+ ,getter ,(or delta 1)))))
    (defmacro decf (place &optional delta)
      "Decrement PLACE by DELTA or 1."
      (declare (debug (gv-place &optional form)))
      (gv-letplace (getter setter) place
        (funcall setter `(- ,getter ,(or delta 1)))))))


;; ---------------------------------------------------------------------------
;; Custom Variables

(defgroup diff-at-point nil
  "Navigate to and from locations in a diff."
  :group 'diff)

(defcustom diff-at-point-diff-command nil
  "The function called to create a diff in the current repository.

On success it must open a diff buffer and return a non-nil value.

Set this to override the default `vc-root-diff'."
  :type '(choice (const nil) function))


;; ---------------------------------------------------------------------------
;; Implementation

(defun diff-at-point--file-line-to-point
    (current-filename-relative current-line current-column &optional strict)
  "This can be used to navigate to a point in a diff buffer.

Given the file, line and column in the original (non-diff) file,
this returns the point in the diff buffer (an integer) on success,
otherwise a string describing why the point could not be found.

This can be used to implement a utility to open a diff buffer,
then navigate to the point the user was viewing.
However this function doesn't make any change to the buffer state,
that's up to the caller to implement.

CURRENT-FILENAME-RELATIVE the filename to look-up in the diff.
Typically this is the filename of the current buffer,
relative to the repository root.

Arguments CURRENT-LINE & CURRENT-COLUMN define the location in the file.
Typically this is taken from the current `point'.

When STRICT is enabled, only return a point if the line exists in the diff,
otherwise return a point in the closest hunk."
  (declare (important-return-value t))
  ;; The point once found, otherwise a string, see the return value in the doc-string.
  ;; Once set, all loops exit.
  (let ((result nil))
    (save-excursion
      (save-match-data
        (cond
         ((null
           (re-search-forward (concat
                               ;; Filename declaration.
                               "^"
                               "---[[:blank:]]+.*\n" ; '--- '
                               "\\+\\+\\+[[:blank:]]+" ;     '+++ '.
                               ;; Optional 'b/'.
                               "\\(\\|b/\\)" (regexp-quote current-filename-relative)
                               ;; Optional ' (some text)'
                               ;; Subversion quirk.
                               "\\(\\|[[:blank:]]+.*\\)\n" ; Ignore this line.
                               "@@[[:blank:]]+.*[[:blank:]]@@"
                               ;; may have trailing text, ignore this.
                               )
                              nil t))
          (setq result (format "Unable to find filename in diff: %S" current-filename-relative)))
         (t
          (goto-char (pos-bol))
          ;; Fallback point closest to the hunk,
          ;; used if 'current-line' isn't inside the hunk in the diff.
          ;;
          ;; The fallback uses either the beginning or end of the hunk.
          (let ((fallback-point-begin nil)
                (fallback-point-end nil)
                (fallback-point-is-begin nil)
                ;; The distance of the fallback point to the line we're looking for.
                (fallback-delta-lines nil)
                ;; Find the next hunk or file max, to restrict the search.
                (current-filename-diff-point-max
                 (save-excursion
                   (cond
                    ((re-search-forward (concat
                                         "^"
                                         ;; Prefix.
                                         "---[[:blank:]]+.*\n" ; '--- '
                                         "\\+\\+\\+[[:blank:]]+.*\n") ; '+++ '
                                        nil t)
                     ;; Skip non-diff header.
                     ;; Git uses: "diff ..." & "index ..."
                     ;; Subversion uses: "Index ..." & "===...".
                     ;;
                     ;; So use any non-blank line start except for '-' & '+'.
                     ;;
                     ;; NOTE: this could be part of the REGEXP but in practice it's quite slow!
                     ;; so search backwards instead.
                     (let ((pos (match-beginning 0)))
                       (goto-char pos)
                       (forward-line -1)
                       ;; Typically this only runs 1..2 times.
                       (while (and (looking-at "[^-+[:blank:]]" t)
                                   (progn
                                     (setq pos (point))
                                     ;; Prevent a (highly unlikely) eternal loop.
                                     (zerop (forward-line -1)))))
                       pos))
                    (t
                     (point-max))))))

            ;; Now search for the current hunk.
            (save-excursion
              (while (and (null result)
                          (re-search-forward (concat
                                              "^\\(@@\\)[[:blank:]]+"
                                              ;; Previous (ignore).
                                              "-"
                                              "\\([[:digit:]]+\\),\\([[:digit:]]+\\)"
                                              "[[:blank:]]+"
                                              ;; Current (use).
                                              "\\+"
                                              "\\([[:digit:]]+\\),\\([[:digit:]]+\\)"
                                              "[[:blank:]]+@@")
                                             current-filename-diff-point-max t))
                (let* ((diff-hunk-point (match-beginning 1))
                       (diff-hunk-begin
                        (string-to-number
                         (buffer-substring-no-properties (match-beginning 4) (match-end 4))))
                       (diff-hunk-lines
                        (string-to-number
                         (buffer-substring-no-properties (match-beginning 5) (match-end 5))))
                       (diff-hunk-end (+ diff-hunk-begin diff-hunk-lines)))
                  ;; We have something like this:
                  ;; @@ -1,4 +1,5 @@

                  ;; If the last hunk was set as the fallback, use this chunk as the
                  ;; end of that fallback.
                  (when (and (null fallback-point-end) fallback-point-begin)
                    (setq fallback-point-end diff-hunk-point))

                  ;; Scan down to the line...
                  (cond
                   ((< current-line diff-hunk-begin)
                    (let ((delta (- diff-hunk-begin current-line)))
                      (when (or (null fallback-delta-lines) (> fallback-delta-lines delta))
                        (setq fallback-point-begin diff-hunk-point)
                        (setq fallback-point-is-begin t)
                        (setq fallback-delta-lines delta)
                        ;; Set next iteration.
                        (setq fallback-point-end nil))))
                   ((>= current-line diff-hunk-end)
                    (let ((delta (- current-line diff-hunk-end)))
                      (when (or (null fallback-delta-lines) (> fallback-delta-lines delta))
                        (setq fallback-point-begin diff-hunk-point)
                        (setq fallback-point-is-begin nil)
                        (setq fallback-delta-lines delta)
                        ;; Set next iteration.
                        (setq fallback-point-end nil))))
                   (t
                    (let ((diff-line-current diff-hunk-begin))
                      (forward-line)
                      ;; Avoid eternal loop (for mal-formed diffs).
                      (while (null result)
                        (let ((c (char-after (point))))
                          (cond
                           ((null c)
                            (setq result "Unexpected end of diff"))
                           ((memq c '(?\s ?+))
                            (when (eq diff-line-current current-line)
                              (setq result (+ 1 (point) current-column)))
                            (incf diff-line-current))
                           ((eq c ?-)
                            nil)
                           (t
                            (setq result (format "Malformed diff, unexpected character %S" c)))))
                        (forward-line))))))))

            (unless result
              (setq result
                    (cond
                     (strict
                      (format "Unable to find line %d in diff: %S"
                              current-line
                              current-filename-relative))
                     (t
                      ;; Use the beginning or end of the hunk.
                      (save-excursion
                        (cond
                         (fallback-point-is-begin
                          (goto-char fallback-point-begin)
                          (forward-line 1)
                          (forward-char))
                         (t
                          (goto-char (or fallback-point-end current-filename-diff-point-max))
                          (forward-line -1)
                          (forward-char)))
                        (point)))))))))))
    result))

(defun diff-at-point--diff-command-call ()
  "Call `diff-at-point-diff-command' or use the default behavior."
  (condition-case-unless-debug err
      (cond
       (diff-at-point-diff-command
        (funcall diff-at-point-diff-command))
       (t
        ;; Default behavior.
        (vc-root-diff nil)))
    (error
     (message "diff-at-point: error calling `diff-at-point-diff-command': %s"
              (error-message-string err))
     ;; Failure.
     nil)))

(defun diff-at-point--window-lines-from-top (window)
  "Return the number of lines from the top of WINDOW to the current line."
  (declare (important-return-value t))
  (count-lines (window-start window) (pos-bol)))

(defun diff-at-point--window-scroll-from-top (window lines-from-top)
  "Scroll WINDOW so the current line is LINES-FROM-TOP lines from the top.

When LINES-FROM-TOP is nil the view re-centers.

WINDOW must be the selected window."
  (declare (important-return-value nil))
  (cond
   ((null lines-from-top)
    (recenter))
   (t
    (set-window-start window
                      (save-excursion
                        (forward-line (- lines-from-top))
                        (point))
                      t))))


;; ---------------------------------------------------------------------------
;; Public API

;;;###autoload
(defun diff-at-point-open-and-goto-hunk (&optional scroll-reset)
  "Open a diff of the repository in the current frame.
Jumping to the file & line.

When SCROLL-RESET is not nil the view re-centers,
otherwise the offset from the window is kept."
  (declare (important-return-value nil))
  (interactive)
  ;; Any narrowing causes the offset calculations to fail.
  (save-restriction
    (widen)

    (let* ((current-filename (buffer-file-name))
           (current-line (line-number-at-pos))
           (current-column (- (point) (pos-bol)))

           (init-buffer (current-buffer))
           (init-window (selected-window))
           (lines-from-top
            (cond
             (scroll-reset
              nil)
             (t
              (diff-at-point--window-lines-from-top init-window))))

           ;; Replace the current window.
           (pop-up-windows nil))

      (when (diff-at-point--diff-command-call)
        (cond
         ((eq init-buffer (current-buffer))
          (message
           (concat
            "While 'diff-at-point-diff-command' succeeded, "
            "no diff buffer was created by 'diff-at-point-diff-command'")))
         (t
          (when current-filename
            (let* ((current-filename-relative
                    (file-relative-name current-filename default-directory))
                   (point-found
                    (diff-at-point--file-line-to-point
                     current-filename-relative current-line current-column)))
              (cond
               ;; A string is used to indicate failure to get the point,
               ;; it may be the current buffer just isn't in the diff,
               ;; not really an error.
               ((stringp point-found)
                (message "diff-at-point: %s" point-found))
               (t
                ;; Go to the file in the diff which we were previously viewing.
                (goto-char point-found)
                (diff-at-point--window-scroll-from-top init-window lines-from-top)))))))))))

;;;###autoload
(defun diff-at-point-goto-source-and-close (&optional scroll-reset)
  "Go to the source and close the current diff buffer.

When SCROLL-RESET is not nil the view re-centers,
otherwise the offset from the window is kept."
  (declare (important-return-value nil))
  (interactive)
  (let* ((buf (current-buffer))
         ;; Replace the current window.
         (pop-up-windows nil)

         (init-window (selected-window))
         (lines-from-top
          (cond
           (scroll-reset
            nil)
           (t
            (diff-at-point--window-lines-from-top init-window)))))

    ;; From 'diff-mode'
    (diff-goto-source)

    (kill-buffer buf)
    ;; Convenient to center the view.
    (diff-at-point--window-scroll-from-top init-window lines-from-top)))

(provide 'diff-at-point)
;; Local Variables:
;; fill-column: 99
;; indent-tabs-mode: nil
;; End:
;;; diff-at-point.el ends here
