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   (when after-p (delete-overlay ov)))
  92
  93 ;;;###autoload
  94 (define-minor-mode diff-hl-mode
  95   "Toggle display of vc diff indicators in the left margin."
  96   :after-hook (diff-hl-update)
  97   (if diff-hl-mode
  98       (add-hook 'after-save-hook 'diff-hl-update nil t)
  99     (remove-hook 'after-save-hook 'diff-hl-update t)))
 100
 101 (defun turn-on-diff-hl-mode ()
 102   (when (buffer-file-name)
 103     (diff-hl-mode 1)))
 104
 105 ;;;###autoload
 106 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
 107   turn-on-diff-hl-mode)
 108
 109 (provide 'diff-hl)