code.delx.au - gnu-emacs-elpa/blob - diff-hl.el

   1 (require 'diff-mode)
   2 (require 'vc)
   3
   4 (defface diff-hl-insert
   5   '((t :inherit diff-added))
   6   "Face used to highlight inserted lines."
   7   :group 'diff-hl)
   8
   9 (defface diff-hl-delete
  10   '((t :inherit diff-removed))
  11   "Face used to highlight deleted lines."
  12   :group 'diff-hl)
  13
  14 (defface diff-hl-change
  15   '((((class color) (min-colors 88) (background light))
  16      :background "#ddddff")
  17     (((class color) (min-colors 88) (background dark))
  18      :background "#333355"))
  19   "Face used to highlight changed lines."
  20   :group 'diff-hl)
  21
  22 (define-fringe-bitmap 'diff-hl-empty [0] 1 1 'center)
  23
  24 (defun diff-hl-changes ()
  25   (let* ((buf-name " *vc-bg-diff* ")
  26          (vc-git-diff-switches nil)
  27          (vc-hg-diff-switches nil)
  28          (vc-diff-switches '("-U0"))
  29          (vc-disable-async-diff t)
  30          (file (buffer-file-name))
  31          (backend (vc-backend file))
  32          res)
  33     (when backend
  34       (vc-call-backend backend 'diff (list file) nil nil buf-name)
  35       (with-current-buffer buf-name
  36         (goto-char (point-min))
  37         (unless (eobp)
  38           (diff-beginning-of-hunk t)
  39           (while (looking-at diff-hunk-header-re-unified)
  40             (let ((line (string-to-number (match-string 3)))
  41                   (len (let ((m (match-string 4)))
  42                          (if m (string-to-number m) 1)))
  43                   (beg (point)))
  44                (diff-end-of-hunk)
  45               (let* ((inserts (diff-count-matches "^\\+" beg (point)))
  46                      (deletes (diff-count-matches "^-" beg (point)))
  47                      (type (cond ((zerop deletes) 'insert)
  48                                  ((zerop inserts) 'delete)
  49                                  (t 'change))))
  50                 (push (list line len type) res)))))))
  51     (nreverse res)))
  52
  53 (defmacro diff-hl-defspec (symbol)
  54   (let* ((type-str (symbol-name type))
  55          (spec-sym (intern (concat "diff-hl-" type-str "-spec")))
  56          (face-sym (intern (concat "diff-hl-" type-str))))
  57     `(defconst ,spec-sym
  58        ,(propertize " " 'display `((left-fringe diff-hl-empty ,face-sym))))))
  59
  60 (mapc (lambda (type) (diff-hl-defspec type)) '(insert delete change))
  61
  62 (defun diff-hl-update ()
  63   (let ((changes (diff-hl-changes))
  64         (current-line 1))
  65     (save-excursion
  66       (goto-char (point-min))
  67       (mapc (lambda (o) (when (overlay-get o 'diff-hl) (delete-overlay o)))
  68             (overlays-in (point-min) (point-max)))
  69       (dolist (c changes)
  70         (destructuring-bind (line len type) c
  71           (when (eq type 'delete)
  72             (setq len 1)
  73             (incf line))
  74           (forward-line (- line current-line))
  75           (setq current-line line)
  76           (while (plusp len)
  77             (let ((o (make-overlay (point) (line-end-position))))
  78               (overlay-put o 'diff-hl t)
  79               (overlay-put o 'before-string
  80                            (case type
  81                              ('insert diff-hl-insert-spec)
  82                              ('delete diff-hl-delete-spec)
  83                              ('change diff-hl-change-spec)))
  84               (overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
  85               (overlay-put o 'insert-in-front-hooks '(diff-hl-overlay-modified)))
  86             (forward-line 1)
  87             (incf current-line)
  88             (decf len)))))))
  89
  90 (defun diff-hl-overlay-modified (ov after-p beg end &optional length)
  91   ;; Do the simplest possible thing for now.
  92   (when after-p (delete-overlay ov)))
  93
  94 (defvar diff-hl-timer nil)
  95
  96 (defun diff-hl-edit (beg end len)
  97   ;; DTRT when we've `undo'-ed the buffer into unmodified state.
  98   (when undo-in-progress
  99     (when diff-hl-timer
 100       (cancel-timer diff-hl-timer))
 101     (setq diff-hl-timer
 102           (run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer)))))
 103
 104 (defun diff-hl-after-undo (buffer)
 105   (with-current-buffer buffer
 106     (unless (buffer-modified-p)
 107       (diff-hl-update))))
 108
 109 ;;;###autoload
 110 (define-minor-mode diff-hl-mode
 111   "Toggle display of vc diff indicators in the left margin."
 112   :after-hook (diff-hl-update)
 113   (if diff-hl-mode
 114       (progn
 115         (add-hook 'after-save-hook 'diff-hl-update nil t)
 116         (add-hook 'after-change-functions 'diff-hl-edit nil t))
 117     (remove-hook 'after-save-hook 'diff-hl-update t)
 118     (remove-hook 'after-change-functions 'diff-hl-edit t)))
 119
 120 (defun turn-on-diff-hl-mode ()
 121   (when (buffer-file-name)
 122     (diff-hl-mode 1)))
 123
 124 ;;;###autoload
 125 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
 126   turn-on-diff-hl-mode)
 127
 128 (provide 'diff-hl)