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

   1 (require 'diff-mode)
   2 (require 'vc)
   3
   4 (defface diff-hl-insert
   5   '((default :inherit diff-added)
   6     (((class color) (min-colors 88)) :background "#33dd33"))
   7   "Face used to highlight inserted lines."
   8   :group 'diff-hl)
   9
  10 (defface diff-hl-delete
  11   '((default :inherit diff-removed)
  12     (((class color) (min-colors 88)) :background "#dd3333"))
  13   "Face used to highlight deleted lines."
  14   :group 'diff-hl)
  15
  16 (defface diff-hl-change
  17   '((default :inherit diff-changed)
  18     (((class color) (min-colors 88)) :background "#3333dd"))
  19   "Face used to highlight changed lines."
  20   :group 'diff-hl)
  21
  22 (defun diff-hl-changes ()
  23   (let* ((buf-name " *vc-bg-diff* ")
  24          (vc-git-diff-switches nil)
  25          (vc-hg-diff-switches nil)
  26          (vc-diff-switches '("-U0"))
  27          (file (buffer-file-name))
  28          (vc-handled-backends (default-value 'vc-handled-backends))
  29          (backend (vc-backend file))
  30          res)
  31     (when backend
  32       (vc-call-backend backend 'diff (list file) nil nil buf-name)
  33       (with-current-buffer buf-name
  34         (goto-char (point-min))
  35         (unless (eobp)
  36           (diff-beginning-of-hunk t)
  37           (while (looking-at diff-hunk-header-re-unified)
  38             (let ((line (string-to-number (match-string 3)))
  39                   (len (let ((m (match-string 4)))
  40                          (if m (string-to-number m) 1)))
  41                   (beg (point)))
  42                (diff-end-of-hunk)
  43               (let* ((inserts (diff-count-matches "^\\+" beg (point)))
  44                      (deletes (diff-count-matches "^-" beg (point)))
  45                      (type (cond ((zerop deletes) 'insert)
  46                                  ((zerop inserts) 'delete)
  47                                  (t 'change))))
  48                 (push (list line len type) res)))))))
  49     (nreverse res)))
  50
  51 (defmacro diff-hl-defspec (symbol)
  52   (let* ((type-str (symbol-name type))
  53          (spec-sym (intern (concat "diff-hl-" type-str "-spec")))
  54          (face-sym (intern (concat "diff-hl-" type-str))))
  55     `(defconst ,spec-sym ,(propertize " " 'display
  56                                       `((margin left-margin)
  57                                         ,(propertize " " 'face 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       (set-window-margins nil 1 (cdr (window-margins)))
  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           (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             (forward-line 1)
  84             (incf current-line)
  85             (decf len)))))))
  86
  87 (provide 'diff-hl)