-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmode-line-color.el
92 lines (75 loc) · 3.29 KB
/
mode-line-color.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
;;;https://raw.githubusercontent.com/tarao/elisp/master/mode-line-color.el
(eval-when-compile (require 'cl))
(defgroup mode-line-color nil
"Mode line color."
:prefix "mode-line-color-"
:group 'mode-line)
(defcustom mode-line-color-buffers-regexp '("^\\*scratch\\*$")
"List of regular expressions of buffer names to enable mode-line-color-mode automatically."
:group 'mode-line-color
:type '(repeat 'string))
(defcustom mode-line-color-exclude-buffers-regexp '("^ ")
"List of regular expressions of buffer names not to enable mode-line-color-mode automatically."
:group 'mode-line-color
:type '(repeat 'string))
(defvar mode-line-color-hook nil
"hook for setting mode line color
Usage:
(defun your-function-to-set-mode-line-color (setter)
(funcall setter \"yellow\"))
(add-hook 'mode-line-color-hook 'your-function-to-set-mode-line-color)")
(defvar mode-line-color-mode nil)
(defvar mode-line-color-color nil)
(defvar mode-line-color-original nil)
(defvar mode-line-color-activated nil)
(make-variable-buffer-local 'mode-line-color-activated)
(defun mode-line-color-set-color (color)
(setq mode-line-color-color color))
(defun mode-line-color-excluded-p ()
(let* ((buffer (current-buffer)) (name (buffer-name buffer)))
(flet ((mem-pat (s l)
(memq nil (mapcar #'(lambda (r) (not (string-match-p r s))) l))))
(or (minibufferp buffer)
(and (not (mem-pat name mode-line-color-buffers-regexp))
(mem-pat name mode-line-color-exclude-buffers-regexp))))))
(defun mode-line-color-active-p ()
(unless mode-line-color-activated ; make cache
(let ((exclude (mode-line-color-excluded-p)))
(setq mode-line-color-activated (if exclude 0 1))))
(= 1 mode-line-color-activated))
(defun mode-line-color-update (&optional force)
(if (mode-line-color-active-p)
(let ((mode-line-color-color nil))
(run-hook-with-args 'mode-line-color-hook 'mode-line-color-set-color)
(set-face-background 'mode-line (or mode-line-color-color
mode-line-color-original)))
(unless (minibufferp)
(set-face-background 'mode-line mode-line-color-original))))
(defmacro define-mode-line-color (bind &rest body)
(declare (indent defun))
(let ((prev (nth 0 bind)))
`(add-hook 'mode-line-color-hook
#'(lambda (setter)
(let* ((,prev mode-line-color-color) (color (progn ,@body)))
(when color (funcall setter color)))))))
(defun mode-line-color-install ()
(unless mode-line-color-original
(setq mode-line-color-original (face-background 'mode-line)))
(add-hook 'post-command-hook 'mode-line-color-update))
(defun mode-line-color-uninstall ()
(set-face-background 'mode-line mode-line-color-original)
(remove-hook 'post-command-hook 'mode-line-color-update))
(defadvice set-buffer (after update-mode-line-color activate)
(when (eq (current-buffer) (window-buffer (selected-window)))
(mode-line-color-update)))
(defadvice kill-buffer (after update-mode-line-color activate)
(mode-line-color-update))
;;;###autoload
(define-minor-mode mode-line-color-mode
"Set color of mode line."
:global t
:group 'mode-line-color
(if mode-line-color-mode
(mode-line-color-install)
(mode-line-color-uninstall)))
(provide 'mode-line-color)