GNU bug report logs - #9205
24.0.50; colored mark in vc mode-line

Previous Next

Full log

View this message in rfc822 format

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Peter Münster <pmlists <at> free.fr>
Cc: 9205 <at> debbugs.gnu.org, Stefan Reichör <stefan <at> xsteve.at>, Stefan Monnier <monnier <at> IRO.UMontreal.CA>, Chong Yidong <cyd <at> gnu.org>
Subject: bug#9205: 24.0.50; colored mark in vc mode-line
Date: Tue, 01 Mar 2016 12:47:55 +1100

Lars Ingebrigtsen <larsi <at> gnus.org> writes:

> I started to work on this now, but I thought I'd do it with SVGs, since
> the size of the mode line can vary, and SVGs can be made on the fly.
>
> However, I'm having trouble creating an SVG with transparent
> backgrounds, and it needs to be that, because the mode line changes
> background colour when the window is selected or not.
>
> Doesn't Emacs support SVGs with transparent backgrounds?

Apparently not...

Anyway, here's as far as I got before I discovered the problem.  We
could go with an XPM instead, but it would only approximately match the
height of the mode line, so I'm not sure it's worth it...

diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 0c1718e..4a7acb8 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -717,6 +717,32 @@ vc-mode-line
   (force-mode-line-update)
   backend)
 
+(defun vc--face-color (color)
+  (concat
+   "#"
+   (mapconcat
+    (lambda (elem)
+      (format "%02x" (round (* elem 256))))
+    (color-name-to-rgb color)
+    "")))
+
+(defun vc--color-status (string color)
+  (if (not (image-type-available-p 'svg))
+      string
+    (propertize string
+                'display
+                (let* ((height (- (window-font-height nil 'mode-line) 6))
+                       (svg (svg-create height height)))
+                  (svg-rectangle svg 0 0 height height
+                                 :fill-color (vc--face-color
+                                              (face-background 'mode-line)))
+                  (svg-circle svg (/ height 2) (/ height 2) (/ height 2)
+                              :fill-color color)
+                  (let ((image (svg-image svg)))
+                    (setf (image-property image :ascent) 80)
+                    (setf (image-property image :scale) 1)
+                    image)))))
+
 (defun vc-default-mode-line-string (backend file)
   "Return a string for `vc-mode-line' to put in the mode line for FILE.
 Format:
@@ -739,11 +765,11 @@ vc-default-mode-line-string
 		(eq state 'needs-update))
 	    (setq state-echo "Up to date file")
 	    (setq face 'vc-up-to-date-state)
-	    (concat backend-name "-" rev))
+	    (concat backend-name (vc--color-status "-" "green") rev))
 	   ((stringp state)
 	    (setq state-echo (concat "File locked by" state))
 	    (setq face 'vc-locked-state)
-	    (concat backend-name ":" state ":" rev))
+	    (concat backend-name (vc--color-status ":" "orange") state ":" rev))
            ((eq state 'added)
             (setq state-echo "Locally added file")
 	    (setq face 'vc-locally-added-state)
@@ -751,22 +777,22 @@ vc-default-mode-line-string
            ((eq state 'conflict)
             (setq state-echo "File contains conflicts after the last merge")
 	    (setq face 'vc-conflict-state)
-            (concat backend-name "!" rev))
+            (concat backend-name (vc--color-status "!" "red") rev))
            ((eq state 'removed)
             (setq state-echo "File removed from the VC system")
 	    (setq face 'vc-removed-state)
-            (concat backend-name "!" rev))
+            (concat backend-name (vc--color-status "!" "red") rev))
            ((eq state 'missing)
             (setq state-echo "File tracked by the VC system, but missing from the file system")
 	    (setq face 'vc-missing-state)
-            (concat backend-name "?" rev))
+            (concat backend-name (vc--color-status "?" "purple") rev))
 	   (t
 	    ;; Not just for the 'edited state, but also a fallback
 	    ;; for all other states.  Think about different symbols
 	    ;; for 'needs-update and 'needs-merge.
 	    (setq state-echo "Locally modified file")
 	    (setq face 'vc-edited-state)
-	    (concat backend-name ":" rev)))
+	    (concat backend-name (vc--color-status ":" "blue") rev)))
      'face face
      'help-echo (concat state-echo " under the " backend-name
 			" version control system"))))


-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.