From: Eshel Yaron <me@eshelyaron.com>
Date: Sat, 13 Jul 2024 19:21:47 +0000 (+0200)
Subject: * lisp/mode-face.el: New file.
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9208a62814f61994a02a5ba7c82a53f4407efcfb;p=emacs.git

* lisp/mode-face.el: New file.
---

diff --git a/lisp/mode-face.el b/lisp/mode-face.el
new file mode 100644
index 00000000000..f4142f47c3a
--- /dev/null
+++ b/lisp/mode-face.el
@@ -0,0 +1,93 @@
+;;; mode-face.el --- Per major mode face remappings  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Maintainer: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: faces
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library defines the Mode Face minor mode.  This minor mode
+;; applies per major mode face remappings to visually distinguish
+;; certain major modes.  To enable Mode Face in all current and future
+;; buffers, use \\[mode-face-global-mode].
+;;
+;; See the `mode-face' customization group for user options that
+;; control which remappings Mode Face mode applies, and when.
+
+;;; Code:
+
+(defgroup mode-face nil
+  "Per major mode face remappings."
+  :group 'display)
+
+(defface mode-face-comint-mode
+  '((t :background "#fff2f3"))
+  "Mode face for `comint-mode'.")
+
+(defface mode-face-help-mode
+  '((t :background "#f0fff0"))
+  "Mode face for `help-mode'.")
+
+(defcustom mode-face-modes '(comint-mode help-mode)
+  "List of major modes in which Mode Face mode should remap faces."
+  :type '(repeat function))
+
+(defcustom mode-face-faces '(default fringe)
+  "List of faces that Mode Face mode should remap."
+  :type '(repeat face))
+
+(defvar-local mode-face-cookie-jar nil)
+
+(declare-function face-remap-remove-relative "face-remap")
+
+;;;###autoload
+(define-minor-mode mode-face-mode
+  "Enable per major mode face remappings.
+
+If the current major mode is derived from one of
+`mode-face-modes', say `foo-mode', this minor mode remaps faces
+in `mode-face-faces' to the face `mode-face-foo-mode'.
+
+By default, this remaps the `default' and `fringe' faces in
+`comint-mode' and `help-mode' to `mode-face-comint-mode' and
+`mode-face-help-mode', respectively."
+  :lighter nil
+  (if mode-face-mode
+      (let ((modes mode-face-modes))
+        (while modes
+          (let ((mode (car modes)))
+            (setq modes
+                  (if (not (derived-mode-p mode))
+                      (cdr modes)
+                    (dolist (face mode-face-faces)
+                      (push (face-remap-add-relative
+                             face (intern (concat "mode-face-"
+                                                  (symbol-name mode))))
+                            mode-face-cookie-jar))))))
+        (unless mode-face-cookie-jar
+          (mode-face-mode -1)))
+    (mapc #'face-remap-remove-relative mode-face-cookie-jar)
+    (setq mode-face-cookie-jar nil))
+  (force-window-update (current-buffer)))
+
+;;;###autoload
+(define-globalized-minor-mode mode-face-global-mode
+  mode-face-mode mode-face-mode)
+
+(provide 'mode-face)
+;;; mode-face.el ends here