Synchronizes Emacs' background color with the terminal background by using VT100 control sequences

appearance-control-sequences.el

;;; appearance-control-sequences.el --- Terminal control sequence integration -*- lexical-binding: t -*-

;;; Commentary:
;;
;; This module synchronizes Emacs' background color with the terminal background
;; by using VT100 control sequences.  It supports both setting the background
;; color (using the "\e]11;" sequence) and resetting it on exit (using "\e]111;"
;; if available, or restoring the original color otherwise).
;;

;;; Code:

(defgroup appearance-control-sequences nil
  "Terminal control sequence integration for Emacs."
  :group 'terminals
  :prefix "appearance-control-sequences-")

(defcustom appearance-control-sequences-sync-background t
  "Whether to synchronize terminal background with Emacs background."
  :type 'boolean
  :group 'appearance-control-sequences)

(defcustom appearance-control-sequences-query-timeout 0.5
  "Timeout in seconds when querying terminal capabilities."
  :type 'number
  :group 'appearance-control-sequences)

(defvar appearance-control-sequences--original-background nil
  "Original terminal background color before modification.")

(defvar appearance-control-sequences--supports-reset nil
  "Whether terminal supports the background reset control sequence (111).")

(defvar appearance-control-sequences--initialized nil
  "Whether terminal capability detection has been performed.")

;;; Internal functions

(defun appearance-control-sequences--query-terminal-color ()
  "Query the terminal for its current background color.
Returns the color string if successful, nil otherwise."
  (when (and (not (display-graphic-p))
             (>= emacs-major-version 25)) ; read-event with timeout needs Emacs 25+
    (let (chr response)
      ;; Send ANSI query sequence to request background color
      (send-string-to-terminal "\e]11;?\e\\")
         
      ;; Validation: properly formatted response begins with escape-bracket
      (when (and (eq (read-event nil nil appearance-control-sequences-query-timeout) ?\e)
                 (eq (read-event nil nil appearance-control-sequences-query-timeout) ?\]))
        
        ;; Collect response characters until terminating backslash
        (setq response "")
        (while (and (not (eq (setq chr (read-event nil nil appearance-control-sequences-query-timeout)) ?\\))
                    chr)
          (setq response (concat response (string chr))))
        
        ;; Extract RGB components from response (format: 11;rgb:RRRR/GGGG/BBBB)
        (when (string-match "11;rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" response)
          response)))))

(defun appearance-control-sequences--detect-terminal-capabilities ()
  "Detect terminal capabilities for background color control.
Returns non-nil if terminal supports background color setting."
  (when (and (not (display-graphic-p))
             (not appearance-control-sequences--initialized))
    ;; First establish baseline by capturing current background
    (setq appearance-control-sequences--original-background 
          (appearance-control-sequences--query-terminal-color))
    
    ;; Probe for reset capability - modern terminals support this sequence
    (when appearance-control-sequences--original-background
      (send-string-to-terminal "\e]111;?\e\\")
      (setq appearance-control-sequences--supports-reset
            (and (eq (read-event nil nil appearance-control-sequences-query-timeout) ?\e)
                 (eq (read-event nil nil appearance-control-sequences-query-timeout) ?\]))))
    
    (setq appearance-control-sequences--initialized t)
    appearance-control-sequences--original-background))

(defun appearance-control-sequences--update-terminal-background (&optional frame)
  "Update terminal background to match FRAME's background color.
If FRAME is nil, use the current frame."
  (when (and appearance-control-sequences-sync-background 
             (not (display-graphic-p))
             appearance-control-sequences--initialized)
    (let ((bg (frame-parameter frame 'background-color)))
      (when bg
        (send-string-to-terminal
         (format "\e]11;%s\a" bg))))))

(defun appearance-control-sequences--reset-terminal-background (&rest _args)
  "Reset terminal background to its original state.
This can be called with any number of arguments, allowing it to be
used with various hooks."
  (when (and appearance-control-sequences-sync-background 
             (not (display-graphic-p))
             appearance-control-sequences--initialized)
    (if appearance-control-sequences--supports-reset
        ;; Use the dedicated reset sequence if supported
        (send-string-to-terminal "\e]111;\a")
      ;; Otherwise, restore the original background color if we saved it
      (when appearance-control-sequences--original-background
        (send-string-to-terminal
         (format "\e]11;%s\a" 
                 (progn
                   (string-match "11;\\(.*\\)" appearance-control-sequences--original-background)
                   (match-string 1 appearance-control-sequences--original-background))))))))

(defun appearance-control-sequences--after-theme-change (&rest _)
  "Update terminal background after theme changes.
This ignores all arguments and just updates the terminal background.
It is designed to be used as advice for theme-related functions."
  (appearance-control-sequences--update-terminal-background))

;;;###autoload
(define-minor-mode appearance-control-sequences-mode
  "Toggle terminal control sequence integration mode.
When enabled, synchronizes terminal background with Emacs background
and ensures proper restoration on exit."
  :global t
  :lighter " CS"
  (if appearance-control-sequences-mode
      (progn
        ;; Perform one-time terminal capability discovery
        (unless appearance-control-sequences--initialized
          (appearance-control-sequences--detect-terminal-capabilities))
        
        ;; Register lifecycle events requiring background updates
        (add-hook 'after-make-frame-functions #'appearance-control-sequences--update-terminal-background)
        (add-hook 'window-configuration-change-hook #'appearance-control-sequences--update-terminal-background)
        (add-hook 'kill-emacs-hook #'appearance-control-sequences--reset-terminal-background)
        (add-hook 'suspend-tty-functions #'appearance-control-sequences--reset-terminal-background)
        (add-hook 'resume-tty-functions #'appearance-control-sequences--update-terminal-background)
        
        ;; Theme changes require special handling via advice
        (advice-add 'load-theme :after #'appearance-control-sequences--after-theme-change)
        
        ;; Apply immediately to sync current state
        (appearance-control-sequences--update-terminal-background))
    
    ;; Deregistration to ensure clean state
    (remove-hook 'after-make-frame-functions #'appearance-control-sequences--update-terminal-background)
    (remove-hook 'window-configuration-change-hook #'appearance-control-sequences--update-terminal-background)
    (remove-hook 'kill-emacs-hook #'appearance-control-sequences--reset-terminal-background)
    (remove-hook 'suspend-tty-functions #'appearance-control-sequences--reset-terminal-background)
    (remove-hook 'resume-tty-functions #'appearance-control-sequences--update-terminal-background)
    
    (advice-remove 'load-theme #'appearance-control-sequences--after-theme-change)

    ;; Explicit cleanup for deterministic behavior
    (appearance-control-sequences--reset-terminal-background)))

;;;###autoload
(defun appearance-control-sequences-update-now ()
  "Force an immediate update of the terminal background color."
  (interactive)
  (appearance-control-sequences--update-terminal-background))

;;;###autoload
(defun appearance-control-sequences-reset-now ()
  "Force an immediate reset of the terminal background color."
  (interactive)
  (appearance-control-sequences--reset-terminal-background))

(appearance-control-sequences-mode 1)

(provide 'appearance-control-sequences)

;;; appearance-control-sequences.el ends here