;;; diff-hl-margin.el --- Highlight buffer changes on margins -*- lexical-binding: t -*-

;; Copyright (C) 2012-2025  Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This is a global mode, it modifies `diff-hl-mode' to use the margin
;; instead of the fringe. To toggle, type `M-x diff-hl-margin-mode'.
;;
;; Compared to the default behavior, this makes `diff-hl-mode'
;; indicators show up even when Emacs is running in a terminal.
;;
;; On the flip side, the indicators look simpler, and they are
;; incompatible with `linum-mode' or any other mode that uses the
;; margin.
;;
;; You might want to enable it conditionally in your init file
;; depending on whether Emacs is running in graphical mode:
;;
;; (unless (window-system) (diff-hl-margin-mode))

(require 'cl-lib)
(require 'diff-hl)
(require 'diff-hl-dired)

(defvar diff-hl-margin-old-highlight-function nil)

(defvar diff-hl-margin-old-highlight-ref-function nil)

(defvar diff-hl-margin-old-width nil)

(defgroup diff-hl-margin nil
  "Highlight buffer changes on margin"
  :group 'diff-hl)

(defface diff-hl-margin-insert
  '((default :inherit diff-hl-insert))
  "Face used to highlight inserted lines on the margin.")

(defface diff-hl-margin-delete
  '((default :inherit diff-hl-delete))
  "Face used to highlight deleted lines on the margin.")

(defface diff-hl-margin-change
  '((default :inherit diff-hl-change))
  "Face used to highlight changed lines on the margin.")

(defface diff-hl-margin-ignored
  '((default :inherit dired-ignored))
  "Face used to highlight changed lines on the margin.")

(defface diff-hl-margin-unknown
  '((default :inherit dired-ignored))
  "Face used to highlight changed lines on the margin.")

(defface diff-hl-margin-reference-insert
  '((default :inherit diff-hl-reference-insert))
  "Face used to highlight lines inserted since reference rev on the margin.")

(defface diff-hl-margin-reference-delete
  '((default :inherit diff-hl-reference-delete))
  "Face used to highlight lines deleted since reference rev on the margin.")

(defface diff-hl-margin-reference-change
  '((default :inherit diff-hl-reference-change))
  "Face used to highlight changed since reference rev on the margin.")

(defcustom diff-hl-margin-symbols-alist
  '((insert . "+") (delete . "-") (change . "!")
    (unknown . "?") (ignored . "i") (reference . " "))
  "Associative list from symbols to strings."
  :type '(alist :key-type symbol
                :value-type string
                :options (insert delete change unknown ignored reference))
  :set (lambda (symbol value)
         (defvar diff-hl-margin-spec-cache)
         (set-default symbol value)
         (setq diff-hl-margin-spec-cache nil)))

;;;###autoload
(define-minor-mode diff-hl-margin-mode
  "Toggle displaying `diff-hl-mode' highlights on the margin."
  :lighter "" :global t
  (if diff-hl-margin-mode
      (progn
        (add-hook 'diff-hl-mode-on-hook 'diff-hl-margin-local-mode)
        (add-hook 'diff-hl-mode-off-hook 'diff-hl-margin-local-mode-off)
        (add-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-local-mode)
        (add-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-local-mode-off))
    (remove-hook 'diff-hl-mode-on-hook 'diff-hl-margin-local-mode)
    (remove-hook 'diff-hl-mode-off-hook 'diff-hl-margin-local-mode-off)
    (remove-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-local-mode)
    (remove-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-local-mode-off))
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (cond
       (diff-hl-mode
        (diff-hl-margin-local-mode (if diff-hl-margin-mode 1 -1))
        (diff-hl-update))
       (diff-hl-dired-mode
        (diff-hl-margin-local-mode (if diff-hl-margin-mode 1 -1))
        (diff-hl-dired-update))))))

;;;###autoload
(define-minor-mode diff-hl-margin-local-mode
  "Toggle displaying `diff-hl-mode' highlights on the margin locally.
You probably shouldn't use this function directly."
  :lighter ""
  (let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
    (if diff-hl-margin-local-mode
        (progn
          (setq-local diff-hl-margin-old-highlight-function
                      diff-hl-highlight-function)
          (setq-local diff-hl-margin-old-highlight-ref-function
                      diff-hl-highlight-reference-function)
          (setq-local diff-hl-highlight-function
                      #'diff-hl-highlight-on-margin)
          (setq-local diff-hl-highlight-reference-function
                      #'diff-hl-highlight-on-margin-flat)
          (setq-local diff-hl-margin-old-width (symbol-value width-var))
          (set width-var 1))
      (when diff-hl-margin-old-highlight-function
        (setq diff-hl-highlight-function diff-hl-margin-old-highlight-function
              diff-hl-highlight-reference-function diff-hl-margin-old-highlight-ref-function
              diff-hl-margin-old-highlight-function nil))
      (set width-var diff-hl-margin-old-width)
      (kill-local-variable 'diff-hl-margin-old-width)))
  (dolist (win (get-buffer-window-list))
    (set-window-buffer win (current-buffer))))

(defun diff-hl-margin-local-mode-off ()
  (diff-hl-margin-local-mode -1))

(defvar diff-hl-margin-spec-cache nil)

(defun diff-hl-margin-spec-cache ()
  (or diff-hl-margin-spec-cache
      (setq diff-hl-margin-spec-cache
            (diff-hl-margin-build-spec-cache))))

(defun diff-hl-margin-build-spec-cache ()
  (nconc
   (cl-loop for (type . char) in diff-hl-margin-symbols-alist
            unless (eq type 'reference)
            nconc
            (cl-loop for side in '(left right)
                     collect
                     (cons
                      (cons type side)
                      (propertize
                       " " 'display
                       `((margin ,(intern (format "%s-margin" side)))
                         ,(propertize char 'face
                                      (intern (format "diff-hl-margin-%s" type))))))))
   (cl-loop for char = (or (assoc-default 'reference diff-hl-margin-symbols-alist)
                           " ")
            for type in '(insert delete change)
            nconc
            (cl-loop for side in '(left right)
                     collect
                     (cons
                      (list type side 'reference)
                      (propertize
                       " " 'display
                       `((margin ,(intern (format "%s-margin" side)))
                         ,(propertize char 'face
                                      (intern (format "diff-hl-margin-reference-%s" type))))))))))

(defun diff-hl-margin-ensure-visible ()
  (let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
    (when (zerop (symbol-value width-var))
      (set width-var 1)
      (dolist (win (get-buffer-window-list))
        (set-window-buffer win (current-buffer))))))

(defun diff-hl-highlight-on-margin (ovl type _shape)
  (diff-hl-margin-ensure-visible)
  (let ((spec (cdr (assoc (cons type diff-hl-side)
                          (diff-hl-margin-spec-cache)))))
    (overlay-put ovl 'before-string spec)))

(defun diff-hl-highlight-on-margin-flat (ovl type _shape)
  (let ((spec (cdr (assoc (list type diff-hl-side 'reference)
                          (diff-hl-margin-spec-cache)))))
    (overlay-put ovl 'before-string spec)))

(provide 'diff-hl-margin)

;;; diff-hl-margin.el ends here
