]> code.delx.au - gnu-emacs-elpa/commitdiff
First commit
authorDmitry Gutov <dgutov@yandex.ru>
Sun, 24 Jun 2012 20:27:51 +0000 (00:27 +0400)
committerDmitry Gutov <dgutov@yandex.ru>
Sun, 24 Jun 2012 20:27:51 +0000 (00:27 +0400)
diff-hl.el [new file with mode: 0644]

diff --git a/diff-hl.el b/diff-hl.el
new file mode 100644 (file)
index 0000000..f9b36a8
--- /dev/null
@@ -0,0 +1,87 @@
+(require 'diff-mode)\r
+(require 'vc)\r
+\r
+(defface diff-hl-insert\r
+  '((default :inherit diff-added)\r
+    (((class color) (min-colors 88)) :background "#33dd33"))\r
+  "Face used to highlight inserted lines."\r
+  :group 'diff-hl)\r
+\r
+(defface diff-hl-delete\r
+  '((default :inherit diff-removed)\r
+    (((class color) (min-colors 88)) :background "#dd3333"))\r
+  "Face used to highlight deleted lines."\r
+  :group 'diff-hl)\r
+\r
+(defface diff-hl-change\r
+  '((default :inherit diff-changed)\r
+    (((class color) (min-colors 88)) :background "#3333dd"))\r
+  "Face used to highlight changed lines."\r
+  :group 'diff-hl)\r
+\r
+(defun diff-hl-changes ()\r
+  (let* ((buf-name " *vc-bg-diff* ")\r
+         (vc-git-diff-switches nil)\r
+         (vc-hg-diff-switches nil)\r
+         (vc-diff-switches '("-U0"))\r
+         (file (buffer-file-name))\r
+         (vc-handled-backends (default-value 'vc-handled-backends))\r
+         (backend (vc-backend file))\r
+         res)\r
+    (when backend\r
+      (vc-call-backend backend 'diff (list file) nil nil buf-name)\r
+      (with-current-buffer buf-name\r
+        (goto-char (point-min))\r
+        (unless (eobp)\r
+          (diff-beginning-of-hunk t)\r
+          (while (looking-at diff-hunk-header-re-unified)\r
+            (let ((line (string-to-number (match-string 3)))\r
+                  (len (let ((m (match-string 4)))\r
+                         (if m (string-to-number m) 1)))\r
+                  (beg (point)))\r
+               (diff-end-of-hunk)\r
+              (let* ((inserts (diff-count-matches "^\\+" beg (point)))\r
+                     (deletes (diff-count-matches "^-" beg (point)))\r
+                     (type (cond ((zerop deletes) 'insert)\r
+                                 ((zerop inserts) 'delete)\r
+                                 (t 'change))))\r
+                (push (list line len type) res)))))))\r
+    (nreverse res)))\r
+\r
+(defmacro diff-hl-defspec (symbol)\r
+  (let* ((type-str (symbol-name type))\r
+         (spec-sym (intern (concat "diff-hl-" type-str "-spec")))\r
+         (face-sym (intern (concat "diff-hl-" type-str))))\r
+    `(defconst ,spec-sym ,(propertize " " 'display\r
+                                      `((margin left-margin)\r
+                                        ,(propertize " " 'face face-sym))))))\r
+\r
+(mapc (lambda (type) (diff-hl-defspec type)) '(insert delete change))\r
+\r
+(defun diff-hl-update ()\r
+  (let ((changes (diff-hl-changes))\r
+        (current-line 1))\r
+    (save-excursion\r
+      (set-window-margins nil 1 (cdr (window-margins)))\r
+      (goto-char (point-min))\r
+      (mapc (lambda (o) (when (overlay-get o 'diff-hl) (delete-overlay o)))\r
+            (overlays-in (point-min) (point-max)))\r
+      (dolist (c changes)\r
+        (destructuring-bind (line len type) c\r
+          (when (eq type 'delete)\r
+            (setq len 1))\r
+          (forward-line (- line current-line))\r
+          (setq current-line line)\r
+          (while (plusp len)\r
+            (let ((o (make-overlay (point) (line-end-position))))\r
+              (overlay-put o 'diff-hl t)\r
+              (overlay-put o 'before-string\r
+                           (case type\r
+                             ('insert diff-hl-insert-spec)\r
+                             ('delete diff-hl-delete-spec)\r
+                             ('change diff-hl-change-spec))))\r
+            (forward-line 1)\r
+            (incf current-line)\r
+            (decf len)))))))\r
+\r
+(provide 'diff-hl)\r