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

From: Elijah Gabe Pérez <[email-masked]>
Date: Fri, 28 Mar 2025 01:07:02 -0600

Daniel Colascione <[email-masked]> writes:
>>Anyway, I think making the cursor change from a mode hook is a better
>>solution.

I've updated the patch which should use the mode hook instead using
=post-command-hook= or idle timers (and allows (implicitly) to user use
post-command-hook (but that is user responsibility add it or not)).

Also this should refresh the cursor while switching windows.

However I've deleted the function/lambdas support as conditions because
i found it problematic.

I've test it only for overwrite-mode, I ask if anyone wants to give it a try.

>From 275d3ca5fcea03890e422b845477735f3c30d9ad 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 package 'cursor-indicators-mode' (Bug#77224)

This minor mode changes the cursor appearance to indicate
buffers states, such as if overwrite-mode is active or current
buffer is read-only.
Acts similar to 'cua-enable-cursor-indications'
* etc/NEWS: Document new package.
* lisp/cursor-indicators.el: New file.
---
 etc/NEWS                  |  10 +++
 lisp/cursor-indicators.el | 164 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 174 insertions(+)
 create mode 100644 lisp/cursor-indicators.el

diff --git a/etc/NEWS b/etc/NEWS
index cc63d03eafe..2745d467722 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1566,6 +1566,16 @@ 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 package 'cursor-indicators-mode'
+This provides a new minor mode, 'cursor-indicators-mode'.
+This mode changes cursor appearance (color and/or type) to indicate
+different buffer states according to 'cursor-indicators-conditions'.
+The mode have cursor indicators out the box for:
+- Overwrite mode
+- Read-only buffers
+- 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..c97e6d0748a
--- /dev/null
+++ b/lisp/cursor-indicators.el
@@ -0,0 +1,164 @@
+;;; cursor-indicators.el --- Cursor indicators for some states  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Version: 1.0.0
+;; Author: Elías Gabriel Pérez <[email-masked]>
+;; Package-Requires: ((emacs "26.1") (compat "30"))
+
+;; 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 allows changes cursor appearance (color and/or type) to
+;; indicate different buffer states such as if current buffer is
+;; read-only or if overwrite mode is currently active.
+;;
+;; Usage:
+;; For use this mode enable: cursor-indicators-mode.
+;; By default it will set cursor color if overwrite mode is currently
+;; active, if buffer is read-only or if input method is active.
+;;
+;; To change this behavior customize `cursor-indicators-conditions'.
+;; For example, change cursor type to bar when there is a region active:
+;; (setopt cursor-indicators-conditions '((use-region-p . bar)))
+;; Or change both cursor color and type when current buffer have a
+;; specific name:
+;; (setopt cursor-indicators-conditions `((,(lambda () (string-prefix-p " *" (buffer-name)))
+;;                                         hollow "yellow")))
+
+;;; Code:
+(require 'compat)
+
+;;; User options
+
+(defcustom cursor-indicators
+  '((overwrite-mode-hook overwrite-mode "red")
+    (read-only-mode-hook buffer-read-only "green")
+    (input-method-activate-hook current-input-method "blue")
+    (input-method-deactivate-hook current-input-method "blue"))
+  "Alist of conditions to which cursor should change its appearence.
+Only used when `cursor-indicators-mode' is enabled.
+
+Each element is an alist entry in one of these forms:
+  (HOOK CONDITION COLOR)     Change cursor color
+  (HOOK CONDITION TYPE)      Change cursor type
+  (HOOK CONDITION TYPE COLOR)  Change cursor color and type
+
+HOOK must be a hook where conditions will be trigger.
+CONDITION must be a variable that must return non-nil.
+COLOR is a string specifying the cursor color.
+TYPE specifies cursor type.
+
+Valid cursor types are:
+  `box'    - Filled box
+  `bar'    - Vertical bar
+  `hbar'   - Horizontal bar
+  `hollow' - Hollow box
+
+Each element in this alist takes predominance according to its order.
+
+If none of the conditions return non-nil, the cursor will use default
+cursor type and color."
+  :group 'cursor
+  :version "31.1"
+  :type '(alist :key-type
+                (variable :tag "Hook")
+                :value-type
+                (group
+                 (choice :tag "Condition"
+                         (const :tag "Overwrite mode" overwrite-mode)
+                         (const :tag "Read-only mode" buffer-read-only)
+                         (const :tag "Repeat mode" repeat-in-progress)
+                         (const :tag "Activated input method" current-input-method)
+                         ;; User-defined conditions
+                         (function :tag "Variable")
+                         (variable :tag "Function"))
+                 (choice
+                  (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))
+                  (group :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--change-cursor ()
+  "Helper function to `cursor-indicators--update-indications'."
+  ;; Check if KEY is non-nil
+  (dolist (el cursor-indicators)
+    (let ((con (nth 1 el))
+          (type-or-color (nth 2 el))
+          (color (nth 3 el)))
+      (when (and (symbolp con) (boundp con) (symbol-value con))
+        (cond
+         ;; Set cursor color
+         ((and (stringp type-or-color) (not (equal type-or-color (frame-parameter nil 'cursor-color))))
+          (set-cursor-color type-or-color)
+          (setq-local cursor-type (default-value 'cursor-type))) ; Set to default cursor type
+         ;; Set cursor type
+         ((and (symbolp type-or-color) (not (eq type-or-color (default-value 'cursor-type))))
+          (setq-local cursor-type type-or-color)
+          (set-cursor-color cursor-indicators--default-cursor-color)) ; Set to default cursor color
+         ;; Set cursor color and type
+         (color
+          (when (and (symbolp type-or-color) (not (eq type-or-color (default-value 'cursor-type)))
+                     (stringp color) (not (equal color (frame-parameter nil 'cursor-color))))
+            (set-cursor-color color)
+            (setq-local cursor-type type-or-color))))
+        ;; And exit from loop.
+        (throw 'c-i-exit t)))))
+
+(defun cursor-indicators--update-indications (&rest _)
+  ;; C-I-EXIT is used here for exit from loop.
+  (when (and cursor-type
+             (not (catch 'c-i-exit (cursor-indicators--change-cursor))))
+    (setq-local cursor-type (default-value 'cursor-type))
+    (set-cursor-color cursor-indicators--default-cursor-color)))
+
+;;;###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
+different buffer states."
+  :group 'cursor
+  :version "31.1"
+  :global t
+  (if cursor-indicators-mode
+      (progn
+        (add-hook 'after-change-major-mode-hook #'cursor-indicators--update-indications)
+        (add-hook 'window-selection-change-functions #'cursor-indicators--update-indications)
+        ;; Set indicators hooks
+        (dolist (key cursor-indicators)
+          (let ((hook (car key)))
+            (add-hook hook #'cursor-indicators--update-indications 100 t))))
+    ;; Remove all hooks done
+    (remove-hook 'after-change-major-mode-hook #'cursor-indicators--update-indications)
+    (remove-hook 'window-selection-change-functions #'cursor-indicators--update-indications)
+    (dolist (el cursor-indicators)
+      (remove-hook (car el) #'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.