Subject: bug#77224: [PATCH] New minor mode 'cursor-indicators-mode'

From: Elijah Gabe Pérez <[email-masked]>
Date: Mon, 24 Mar 2025 12:10:48 -0600

Juri Linkov <[email-masked]> writes:

>> FWIW, I have this in my init file since forever:

>> (setq my/set-cursor-color-color "")
>> (setq my/set-cursor-color-buffer "")
>> (defun my/set-cursor-color-according-to-mode ()
>> "Change cursor color according to some minor modes."
>> ;; set-cursor-color is somewhat costly, so we only call it when needed:
>> (let ((color
>> (if buffer-read-only "#8888FF"
>> (if overwrite-mode "#000000"
>> "#FF0000"))))
>> (unless (and
>> (string= color my/set-cursor-color-color)
>> (string= (buffer-name) my/set-cursor-color-buffer))
>> (set-cursor-color (setq my/set-cursor-color-color color))
>> (setq my/set-cursor-color-buffer (buffer-name)))))
>> (add-hook 'post-command-hook 'my/set-cursor-color-according-to-mode)

> Cool.  Will it be possible to replace these settings in my init file
> with the new package?

> #+begin_src emacs-lisp
> (defun my-change-cursor (&rest _)
>   "Change cursor color and type depending on insertion mode and input method."
>   (set-cursor-color
>    (cond (repeat-in-progress   "blue")
>          (current-input-method "red3")
>          (t                    "black")))
>   (setq-default cursor-type
>    (cond (overwrite-mode       'box)
>          (t                    'bar))))
> (add-hook 'post-command-hook 'my-change-cursor t)

> ;; Also update the cursor on the repeat timer events:
> (add-function :after repeat-echo-function #'my-change-cursor)
> #+end_src

Sure, I've updated the patch for handle this.

>From 82a59dce91c15a742ed6031b6961e316c8da627b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= <[email-masked]>
Date: Sat, 22 Mar 2025 22:56:01 -0600
Subject: [PATCH] New minor mode 'cursor-indicators-mode'

This minor mode changes the cursor appearance to indicate
buffers states, such as if overwrite-mode is active or current
buffer is read-only. (Bug#77224)
Acts similar to 'cua-enable-cursor-indications'
* etc/NEWS: Document changes.
* lisp/cursor-indicators.el
(cursor-indicators-overwrite-indicator)
(cursor-indicators-repeat-indicator)
(cursor-indicators-input-method-indicator)
(cursor-indicators-read-only-indicator): New user options.
(cursor-indicators--default-cursor-color): New use internal variable.
(cursor-indicators--update-indications): New use internal function.
(cursor-indicators-mode): New minor mode definition.
---
 etc/NEWS                  |   9 ++
 lisp/cursor-indicators.el | 185 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 194 insertions(+)
 create mode 100644 lisp/cursor-indicators.el

diff --git a/etc/NEWS b/etc/NEWS
index cc63d03eafe..a9fee82a29e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1566,6 +1566,15 @@ This user option replaces 'follow-mode-prefix', which had to be set
 before loading Follow mode.  This new option allows you to change the
 prefix even after it was loaded, using 'customize-option' or 'setopt'.
 
+---
+*** New minor mode 'cursor-indicators-mode'
+This mode changes cursor appearance (color and/or type) to indicate
+different buffer states.  This mode have cursor indicators for:
+- Overwrite mode
+- Read-only buffers
+- Repeat mode
+- Input method activation
+
 ---
 *** cdl.el is now obsolete.
 Use 'shell-command' and 'shell-command-on-region' instead.
diff --git a/lisp/cursor-indicators.el b/lisp/cursor-indicators.el
new file mode 100644
index 00000000000..6b9ae9677d7
--- /dev/null
+++ b/lisp/cursor-indicators.el
@@ -0,0 +1,185 @@
+;;; cursor-indicators.el --- Cursor indicators for some states  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: Elías Gabriel Pérez <[email-masked]>
+;; Keywords:
+
+;; 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 package changes cursor appearance (color and/or type) to indicate
+;; different buffer states.
+;;
+;; For example:
+;;
+;; The following setting will use a YELLOW cursor in overwrite mode in read-write
+;; buffers, and a GREEN cursor in read-only buffers:
+;;
+;;  (setq cursor-indicators-overwrite-indicator "yellow")
+;;  (setq cursor-indicators-read-only-indicator "green")
+
+
+;;; Code:
+
+;;; User options
+(defcustom cursor-indicators-overwrite-indicator "red3"
+  "Cursor indicator used when overwrite mode is set, if non-nil.
+Only used when `cursor-indicators-mode' is enabled.
+
+If the value is a COLOR name, then only the `cursor-color' attribute will be
+affected.  If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
+then only the `cursor-type' property will be affected.  If the value is
+a cons (TYPE . COLOR), then both properties are affected.
+If the value is nil then do not change cursor."
+  :group 'cursor
+  :type '(choice
+          (const :tag "None (do not change cursor)" nil)
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Vertical bar" bar)
+		  (const :tag "Horizontal bar" hbar)
+		  (const :tag "Hollow box" hollow))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Vertical bar" bar)
+			(const :tag "Horizontal bar" hbar)
+			(const :tag "Hollow box" hollow))
+		(color :tag "Color"))))
+
+(defcustom cursor-indicators-read-only-indicator "darkgreen"
+  "Cursor indicator used in read-only buffers, if non-nil.
+Only used when `cursor-indicators-mode' is enabled.
+
+If the value is a COLOR name, then only the `cursor-color' attribute will be
+affected.  If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
+then only the `cursor-type' property will be affected.  If the value is
+a cons (TYPE . COLOR), then both properties are affected.
+If the value is nil then do not change cursor."
+  :group 'cursor
+  :type '(choice
+          (const :tag "None (do not change cursor)" nil)
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Vertical bar" bar)
+		  (const :tag "Horizontal bar" hbar)
+		  (const :tag "Hollow box" hollow))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Vertical bar" bar)
+			(const :tag "Horizontal bar" hbar)
+			(const :tag "Hollow box" hollow))
+		(color :tag "Color"))))
+
+(defcustom cursor-indicators-repeat-indicator "blue"
+  "Cursor indicator used when `repeat-in-progress' is non-nil.
+Only used when `cursor-indicators-mode' is enabled.
+
+If the value is a COLOR name, then only the `cursor-color' attribute will be
+affected.  If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
+then only the `cursor-type' property will be affected.  If the value is
+a cons (TYPE . COLOR), then both properties are affected.
+If the value is nil then do not change cursor."
+  :group 'cursor
+  :type '(choice
+          (const :tag "None (do not change cursor)" nil)
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Vertical bar" bar)
+		  (const :tag "Horizontal bar" hbar)
+		  (const :tag "Hollow box" hollow))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Vertical bar" bar)
+			(const :tag "Horizontal bar" hbar)
+			(const :tag "Hollow box" hollow))
+		(color :tag "Color"))))
+
+(defcustom cursor-indicators-input-method-indicator "dark magenta"
+  "Cursor indicator used when input method is activated now.
+Only used when `cursor-indicators-mode' is enabled.
+
+If the value is a COLOR name, then only the `cursor-color' attribute will be
+affected.  If the value is a cursor TYPE (one of: box, hollow, bar, or hbar),
+then only the `cursor-type' property will be affected.  If the value is
+a cons (TYPE . COLOR), then both properties are affected.
+If the value is nil then do not change cursor."
+  :group 'cursor
+  :type '(choice
+          (const :tag "None (do not change cursor)" nil)
+	  (color :tag "Color")
+	  (choice :tag "Type"
+		  (const :tag "Filled box" box)
+		  (const :tag "Vertical bar" bar)
+		  (const :tag "Horizontal bar" hbar)
+		  (const :tag "Hollow box" hollow))
+	  (cons :tag "Color and Type"
+		(choice :tag "Type"
+			(const :tag "Filled box" box)
+			(const :tag "Vertical bar" bar)
+			(const :tag "Horizontal bar" hbar)
+			(const :tag "Hollow box" hollow))
+		(color :tag "Color"))))
+
+;;; Internal Code
+
+(defvar cursor-indicators--default-cursor-color (frame-parameter nil 'cursor-color))
+
+(defun cursor-indicators--update-indications (&optional cursor-color)
+  (let* ((cursor
+          (or
+           ;; CURSOR-COLOR is intended to be used by the user in an advice-add
+           cursor-color
+           ;; XXX: global mark?
+           ;; (and cua--global-mark-active cursor-indicators-global-mark-color)
+           (and buffer-read-only cursor-indicators-read-only-indicator)
+           (and overwrite-mode cursor-indicators-overwrite-indicator)
+           (and (bound-and-true-p repeat-in-progress) cursor-indicators-repeat-indicator)
+           (and (bound-and-true-p current-input-method) cursor-indicators-input-method-indicator)
+           (cons (default-value 'cursor-type)
+                 cursor-indicators--default-cursor-color)))
+         (color (if (consp cursor) (cdr cursor) cursor))
+         (type (if (consp cursor) (car cursor) cursor)))
+    (if (and color
+             (stringp color)
+             (not (equal color (frame-parameter nil 'cursor-color))))
+        (set-cursor-color color))
+    (if (and type
+             (symbolp type)
+             (not (eq type (default-value 'cursor-type))))
+        (setq-local cursor-type type))))
+
+;;;###autoload
+(define-minor-mode cursor-indicators-mode
+  "Change cursor type and/or face for indications.
+When enabled, this mode changes the cursor appearance to indicate
+overwrite mode or read-only buffers."
+  :group 'cursor
+  :global t
+  (if cursor-indicators-mode
+      (progn
+	(add-hook 'post-command-hook #'cursor-indicators--update-indications)
+        (cursor-indicators--update-indications))
+    (remove-hook 'post-command-hook #'cursor-indicators--update-indications)
+    (set-cursor-color cursor-indicators--default-cursor-color)
+    (setq-local cursor-type (default-value 'cursor-type))))
+
+(provide 'cursor-indicators)
+;;; cursor-indicators.el ends here
-- 
2.49.0

-- 
                                          - E.G via GNU Emacs and Org.