Draw borders around fringe indicators

[gnu-emacs-elpa] / diff-hl.el

diff --git a/diff-hl.el b/diff-hl.el
index 10006c7c4e348a8d5b6654946e6938c1dfd64dc7..2df0772069a504118e853d13590c07eb98326b89 100644 (file)
--- a/diff-hl.el
+++ b/diff-hl.el
@@ -25,6 +25,10 @@
   (require 'vc-git)\r
   (require 'vc-hg))\r
 \r
+(defgroup diff-hl nil\r
+  "VC diff fringe highlighting"\r
+  :group 'vc)\r
+\r
 (defface diff-hl-insert\r
   '((t :inherit diff-added))\r
   "Face used to highlight inserted lines."\r
@@ -39,11 +43,46 @@
   '((((class color) (min-colors 88) (background light))\r
      :background "#ddddff")\r
     (((class color) (min-colors 88) (background dark))\r
-     :background "#333355"))\r
+     :background "#333355")\r
+    (((class color))\r
+     :foreground "blue"))\r
   "Face used to highlight changed lines."\r
   :group 'diff-hl)\r
 \r
-(define-fringe-bitmap 'diff-hl-empty [0] 1 1 'center)\r
+(defcustom diff-hl-draw-borders t\r
+  "Non-nil to draw borders around fringe indicators."\r
+  :group 'diff-hl\r
+  :type 'boolean)\r
+\r
+(when (window-system)\r
+  (define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center)\r
+  (let* ((h (frame-char-height))\r
+         (w (frame-parameter nil 'left-fringe))\r
+         (middle (make-vector h (expt 2 (1- w))))\r
+         (ones (1- (expt 2 w)))\r
+         (top (copy-sequence middle))\r
+         (bottom (copy-sequence middle))\r
+         (single (copy-sequence middle)))\r
+    (aset top 0 ones)\r
+    (aset bottom (1- h) ones)\r
+    (aset single 0 ones)\r
+    (aset single (1- h) ones)\r
+    (define-fringe-bitmap 'diff-hl-bmp-top top h 8 'top)\r
+    (define-fringe-bitmap 'diff-hl-bmp-middle middle h 8 'center)\r
+    (define-fringe-bitmap 'diff-hl-bmp-bottom bottom h 8 'bottom)\r
+    (define-fringe-bitmap 'diff-hl-bmp-single single h 8 'center)))\r
+\r
+(defvar diff-hl-spec-cache (make-hash-table :test 'equal))\r
+\r
+(defun diff-hl-fringe-spec (type pos)\r
+  (let* ((key (cons type pos))\r
+         (val (gethash key diff-hl-spec-cache)))\r
+    (unless val\r
+      (let* ((face-sym (intern (concat "diff-hl-" (symbol-name type))))\r
+             (bmp-sym (intern (concat "diff-hl-bmp-" (symbol-name pos)))))\r
+        (setq val (propertize " " 'display `((left-fringe ,bmp-sym ,face-sym))))\r
+        (puthash key val diff-hl-spec-cache)))\r
+    val))\r
 \r
 (defun diff-hl-changes ()\r
   (let* ((buf-name " *vc-diff-hl* ")\r
@@ -74,15 +113,6 @@
                 (push (list line len type) res)))))))\r
     (nreverse res)))\r
 \r
-(eval-and-compile\r
-  (dolist (type '(insert delete change))\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
-      (eval `(defconst ,spec-sym\r
-               ,(propertize " " 'display\r
-                            `((left-fringe diff-hl-empty ,face-sym))))))))\r
-\r
 (defun diff-hl-update ()\r
   (let ((changes (diff-hl-changes))\r
         (current-line 1))\r
@@ -100,10 +130,13 @@
             (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
+                           (diff-hl-fringe-spec\r
+                            type\r
+                            (cond ((not diff-hl-draw-borders) 'empty)\r
+                                  ((and (= len 1) (= line current-line)) 'single)\r
+                                  ((= len 1) 'bottom)\r
+                                  ((= line current-line) 'top)\r
+                                  (t 'middle))))\r
               (overlay-put o 'modification-hooks '(diff-hl-overlay-modified))\r
               (overlay-put o 'insert-in-front-hooks '(diff-hl-overlay-modified)))\r
             (forward-line 1)\r
@@ -152,8 +185,9 @@
 (defun turn-on-diff-hl-mode ()\r
   ;; FIXME: Why is this called twice for each buffer?\r
   ;; Isn't fundamental-mode supposed to not run any hooks?\r
-  (when (and buffer-file-name (not (eq major-mode (default-value 'major-mode))))\r
-    (diff-hl-mode 1)))\r
+  (and buffer-file-name (not (eq major-mode (default-value 'major-mode)))\r
+       (window-system) ;; No fringes in the console.\r
+       (diff-hl-mode 1)))\r
 \r
 ;;;###autoload\r
 (define-globalized-minor-mode global-diff-hl-mode diff-hl-mode\r