From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Lars Ingebrigtsen Newsgroups: gmane.emacs.bugs Subject: bug#9205: 24.0.50; colored mark in vc mode-line Date: Tue, 01 Mar 2016 12:47:55 +1100 Message-ID: <877fhn3r5g.fsf@gnus.org> References: <874o25jq5b.fsf@micropit.couberia.bzh> <87vcl64vlk.fsf@gnu.org> <87bomxyqpl.fsf@micropit.couberia.bzh> <87k41kyeaz.fsf@micropit.couberia.bzh> <87bn6z3rfo.fsf@gnus.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1456796963 4850 80.91.229.3 (1 Mar 2016 01:49:23 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 1 Mar 2016 01:49:23 +0000 (UTC) Cc: 9205@debbugs.gnu.org, Stefan =?UTF-8?Q?Reich=C3=B6r?= , Stefan Monnier , Chong Yidong To: Peter =?UTF-8?Q?M=C3=BCnster?= Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Mar 01 02:49:12 2016 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1aaZR2-0002Fv-71 for geb-bug-gnu-emacs@m.gmane.org; Tue, 01 Mar 2016 02:49:12 +0100 Original-Received: from localhost ([::1]:40193 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aaZR1-000526-IN for geb-bug-gnu-emacs@m.gmane.org; Mon, 29 Feb 2016 20:49:11 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45251) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aaZQw-00051S-Qf for bug-gnu-emacs@gnu.org; Mon, 29 Feb 2016 20:49:09 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aaZQs-0007mr-UE for bug-gnu-emacs@gnu.org; Mon, 29 Feb 2016 20:49:06 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:57272) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aaZQs-0007mm-QJ for bug-gnu-emacs@gnu.org; Mon, 29 Feb 2016 20:49:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84) (envelope-from ) id 1aaZQs-0000MJ-Gc for bug-gnu-emacs@gnu.org; Mon, 29 Feb 2016 20:49:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Lars Ingebrigtsen Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 01 Mar 2016 01:49:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 9205 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 9205-submit@debbugs.gnu.org id=B9205.14567969211351 (code B ref 9205); Tue, 01 Mar 2016 01:49:02 +0000 Original-Received: (at 9205) by debbugs.gnu.org; 1 Mar 2016 01:48:41 +0000 Original-Received: from localhost ([127.0.0.1]:54399 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aaZQW-0000Lh-M2 for submit@debbugs.gnu.org; Mon, 29 Feb 2016 20:48:41 -0500 Original-Received: from hermes.netfonds.no ([80.91.224.195]:39208) by debbugs.gnu.org with esmtp (Exim 4.84) (envelope-from ) id 1aaZQR-0000LW-9u for 9205@debbugs.gnu.org; Mon, 29 Feb 2016 20:48:39 -0500 Original-Received: from 109.179.251.45.tmi.telenormobil.no ([109.179.251.45] helo=mouse) by hermes.netfonds.no with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1aaZPz-0003Oz-NQ; Tue, 01 Mar 2016 02:48:08 +0100 In-Reply-To: <87bn6z3rfo.fsf@gnus.org> (Lars Ingebrigtsen's message of "Tue, 01 Mar 2016 12:41:47 +1100") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.1.50 (gnu/linux) X-MailScanner-ID: 1aaZPz-0003Oz-NQ MailScanner-NULL-Check: 1457401688.93296@yKHYsSFnUOj7Xz7Wr64gbA X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:114193 Archived-At: Lars Ingebrigtsen 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