;;; vc-margin.el --- VC line-change indicator in left margin -*- lexical-binding: t; -*-

(require 'vc)
(require 'vc-git)

(defgroup vc-margin nil
  "Show VC line-change indicators in the left window margin."
  :group 'vc)

(defface vc-margin-added
  '((t (:foreground "black" :background "green")))
  "Face for the added-line glyph."
  :group 'vc-margin)

(defface vc-margin-modified
  '((t (:foreground "black" :background "yellow")))
  "Face for the modified-line glyph."
  :group 'vc-margin)

(defface vc-margin-removed
  '((t (:foreground "white" :background "red")))
  "Face for the deleted-line glyph."
  :group 'vc-margin)

(defcustom vc-margin-added-glyph "+"
  "Glyph shown in the margin for added lines."
  :type 'string :group 'vc-margin)

(defcustom vc-margin-modified-glyph "*"
  "Glyph shown in the margin for modified lines."
  :type 'string :group 'vc-margin)

(defcustom vc-margin-removed-glyph "-"
  "Glyph shown in the margin on the line above a deletion."
  :type 'string :group 'vc-margin)

(defcustom vc-margin-width 1
  "Width reserved in the left margin for change indicators."
  :type 'integer :group 'vc-margin)

(defcustom vc-margin-excluded-modes nil
  "Major modes in which `global-vc-margin-mode' will not auto-enable."
  :type '(repeat symbol) :group 'vc-margin)

(defvar-local vc-margin--overlays nil
  "Overlays currently rendering vc-margin indicators in this buffer.")

(defun vc-margin--clear ()
  "Remove all vc-margin overlays from the current buffer."
  (mapc #'delete-overlay vc-margin--overlays)
  (setq vc-margin--overlays nil))

(defun vc-margin--git-diff ()
  "Return `git diff -U0 HEAD' output for the current buffer's file, or nil."
  (when (and buffer-file-name
             (eq (vc-backend buffer-file-name) 'Git))
    (let* ((file buffer-file-name)
           (root (vc-git-root file)))
      (when root
        (let ((relname (file-relative-name file root)))
          (with-temp-buffer
            (let ((default-directory root))
              (when (zerop (process-file "git" nil t nil
                                         "diff" "--no-color" "-U0" "HEAD" "--"
                                         relname))
                (buffer-string)))))))))

(defun vc-margin--parse-diff (diff-text)
  "Parse DIFF-TEXT and return a list of (LINE . TYPE) entries.
TYPE is one of `added', `modified', or `removed'.  Entries are
sorted by LINE in ascending order."
  (let ((entries nil))
    (with-temp-buffer
      (insert diff-text)
      (goto-char (point-min))
      (while (re-search-forward
              "^@@ -[0-9]+\\(?:,[0-9]+\\)? \\+\\([0-9]+\\)\\(?:,[0-9]+\\)? @@"
              nil t)
        (let ((new-line (string-to-number (match-string 1))))
          (forward-line 1)
          (while (and (not (eobp)) (memq (char-after) '(?- ?+ ?\s)))
            (cond
             ((eq (char-after) ?-)
              (let ((removed 0)
                    (added-lines nil))
                (while (and (not (eobp)) (eq (char-after) ?-))
                  (setq removed (1+ removed))
                  (forward-line 1))
                (while (and (not (eobp)) (eq (char-after) ?+))
                  (push new-line added-lines)
                  (setq new-line (1+ new-line))
                  (forward-line 1))
                (setq added-lines (nreverse added-lines))
                (let ((paired (min removed (length added-lines))))
                  (dotimes (i paired)
                    (push (cons (nth i added-lines) 'modified) entries))
                  (dolist (l (nthcdr paired added-lines))
                    (push (cons l 'added) entries))
                  (when (> removed paired)
                    (push (cons (max 1 (1- new-line)) 'removed) entries)))))
             ((eq (char-after) ?+)
              (push (cons new-line 'added) entries)
              (setq new-line (1+ new-line))
              (forward-line 1))
             ((eq (char-after) ?\s)
              (setq new-line (1+ new-line))
              (forward-line 1)))))))
    (nreverse entries)))

(defun vc-margin--make-overlay-at-point (type)
  "Create a vc-margin overlay for TYPE on the current line."
  (let* ((glyph (pcase type
                  ('added vc-margin-added-glyph)
                  ('modified vc-margin-modified-glyph)
                  ('removed vc-margin-removed-glyph)))
         (face (pcase type
                 ('added 'vc-margin-added)
                 ('modified 'vc-margin-modified)
                 ('removed 'vc-margin-removed)))
         (ov (make-overlay (line-beginning-position) (line-beginning-position))))
    (overlay-put ov 'before-string
                 (propertize " " 'display
                             `((margin left-margin)
                               ,(propertize glyph 'face face))))
    (overlay-put ov 'vc-margin t)
    ov))

(defun vc-margin--apply (entries)
  "Render ENTRIES (sorted by line) as overlays."
  (vc-margin--clear)
  (save-restriction
    (widen)
    (save-excursion
      (goto-char (point-min))
      (let ((current 1))
        (dolist (entry entries)
          (let ((line (car entry)))
            (forward-line (- line current))
            (setq current line)
            (push (vc-margin--make-overlay-at-point (cdr entry))
                  vc-margin--overlays)))))))

(defun vc-margin--set-window-margins ()
  "Reserve `vc-margin-width' columns in the left margin of every window showing this buffer."
  (dolist (win (get-buffer-window-list (current-buffer) nil t))
    (set-window-margins win vc-margin-width (cdr (window-margins win)))))

(defun vc-margin--unset-window-margins ()
  "Restore the left margin to zero in every window showing this buffer."
  (dolist (win (get-buffer-window-list (current-buffer) nil t))
    (set-window-margins win 0 (cdr (window-margins win)))))

(defun vc-margin-refresh ()
  "Recompute and display VC margin indicators for the current buffer."
  (interactive)
  (when vc-margin-mode
    (let ((diff (vc-margin--git-diff)))
      (vc-margin--apply (and diff (vc-margin--parse-diff diff))))
    (vc-margin--set-window-margins)))

(defun vc-margin--after-save ()
  (when vc-margin-mode (vc-margin-refresh)))

(define-minor-mode vc-margin-mode
  "Show per-line VC change indicators in the left window margin.
Indicators are recomputed when the buffer is saved or reverted.
Currently only the Git backend is supported."
  :lighter " vcM"
  (cond
   (vc-margin-mode
    (add-hook 'after-save-hook #'vc-margin--after-save nil t)
    (add-hook 'after-revert-hook #'vc-margin--after-save nil t)
    (add-hook 'window-configuration-change-hook
              #'vc-margin--set-window-margins nil t)
    (vc-margin-refresh))
   (t
    (remove-hook 'after-save-hook #'vc-margin--after-save t)
    (remove-hook 'after-revert-hook #'vc-margin--after-save t)
    (remove-hook 'window-configuration-change-hook
                 #'vc-margin--set-window-margins t)
    (vc-margin--clear)
    (vc-margin--unset-window-margins))))

(defun vc-margin--should-enable-p ()
  "Return non-nil if `vc-margin-mode' should auto-enable in the current buffer."
  (and buffer-file-name
       (not (minibufferp))
       (not (file-remote-p buffer-file-name))
       (not (apply #'derived-mode-p vc-margin-excluded-modes))
       (eq (vc-backend buffer-file-name) 'Git)))

(defun vc-margin--turn-on ()
  "Enable `vc-margin-mode' in the current buffer if appropriate."
  (when (vc-margin--should-enable-p)
    (vc-margin-mode 1)))

(define-globalized-minor-mode global-vc-margin-mode
  vc-margin-mode
  vc-margin--turn-on
  :group 'vc-margin)

(provide 'vc-margin)

;;; vc-margin.el ends here
