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          (file (buffer-file-name))
  30          (backend (vc-backend file))
  31          res)
  32     (when backend
  33       (vc-call-backend backend 'diff (list file) nil nil buf-name)
  34       (with-current-buffer buf-name
  35         (goto-char (point-min))
  36         (unless (eobp)
  37           (diff-beginning-of-hunk t)
  38           (while (looking-at diff-hunk-header-re-unified)
  39             (let ((line (string-to-number (match-string 3)))
  40                   (len (let ((m (match-string 4)))
  41                          (if m (string-to-number m) 1)))
  42                   (beg (point)))
  43                (diff-end-of-hunk)
  44               (let* ((inserts (diff-count-matches "^\\+" beg (point)))
  45                      (deletes (diff-count-matches "^-" beg (point)))
  46                      (type (cond ((zerop deletes) 'insert)
  47                                  ((zerop inserts) 'delete)
  48                                  (t 'change))))
  49                 (push (list line len type) res)))))))
  50     (nreverse res)))
  51
  52 (defmacro diff-hl-defspec (symbol)
  53   (let* ((type-str (symbol-name type))
  54          (spec-sym (intern (concat "diff-hl-" type-str "-spec")))
  55          (face-sym (intern (concat "diff-hl-" type-str))))
  56     `(defconst ,spec-sym
  57        ,(propertize " " 'display `((left-fringe diff-hl-empty ,face-sym))))))
  58
  59 (mapc (lambda (type) (diff-hl-defspec type)) '(insert delete change))
  60
  61 (defun diff-hl-update ()
  62   (let ((changes (diff-hl-changes))
  63         (current-line 1))
  64     (save-excursion
  65       (goto-char (point-min))
  66       (mapc (lambda (o) (when (overlay-get o 'diff-hl) (delete-overlay o)))
  67             (overlays-in (point-min) (point-max)))
  68       (dolist (c changes)
  69         (destructuring-bind (line len type) c
  70           (when (eq type 'delete)
  71             (setq len 1)
  72             (incf line))
  73           (forward-line (- line current-line))
  74           (setq current-line line)
  75           (while (plusp len)
  76             (let ((o (make-overlay (point) (line-end-position))))
  77               (overlay-put o 'diff-hl t)
  78               (overlay-put o 'before-string
  79                            (case type
  80                              ('insert diff-hl-insert-spec)
  81                              ('delete diff-hl-delete-spec)
  82                              ('change diff-hl-change-spec)))
  83               (overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
  84               (overlay-put o 'insert-in-front-hooks '(diff-hl-overlay-modified)))
  85             (forward-line 1)
  86             (incf current-line)
  87             (decf len)))))))
  88
  89 (defun diff-hl-overlay-modified (ov after-p beg end &optional length)
  90   (when after-p (delete-overlay ov)))
  91
  92 ;;;###autoload
  93 (define-minor-mode diff-hl-mode
  94   "Toggle display of vc diff indicators in the left margin."
  95   :after-hook (diff-hl-update)
  96   (if diff-hl-mode
  97       (add-hook 'after-save-hook 'diff-hl-update nil t)
  98     (remove-hook 'after-save-hook 'diff-hl-update t)))
  99
 100 (provide 'diff-hl)