(in-package :cl-tty.backend) ;;; ─── Detection cache ──────────────────────────────────────────────────────── (defvar *detected-backend* nil "Cached backend instance from detect-backend. Nil = not yet detected.") ;;; ─── Environment probe ────────────────────────────────────────────────────── (defun detect-backend-by-env () "Check COLORTERM environment variable for modern terminal support. Returns :modern if COLORTERM contains 'truecolor' or '24bit', nil otherwise." (let ((colorterm (sb-ext:posix-getenv "COLORTERM"))) (when (and colorterm (or (search "truecolor" colorterm :test #'char-equal) (search "24bit" colorterm :test #'char-equal))) :modern))) ;;; ─── TTY probe ────────────────────────────────────────────────────────────── (defun detect-backend-by-tty () "Check if stdout is a real terminal (not a pipe/redirect). Returns T if stdout is interactive, nil otherwise." (interactive-stream-p *standard-output*)) ;;; ─── DA1 terminal query ───────────────────────────────────────────────────── (defun query-terminal (query &optional (timeout 0.1)) "Send QUERY string to terminal and return any response received within TIMEOUT seconds. Returns the response string, or nil if no response." (write-string query *query-io*) (force-output *query-io*) (sleep timeout) (let ((response (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))) (loop while (listen *query-io*) do (vector-push-extend (read-char-no-hang *query-io*) response)) (when (plusp (length response)) response))) (defun detect-backend-by-da1 () "Send DA1 (ESC[c) query and check for kitty terminal response code. Returns T if terminal reports kitty compatibility codes." (let ((response (query-terminal (format nil "~C[c" #\Esc)))) (when response ;; DA1 response format: ESC [ ? digits ; digits c ;; Kitty reports code 62 in the response (search "?62" response)))) ;;; ─── Orchestrator ─────────────────────────────────────────────────────────── (defun detect-backend () "Auto-detect the appropriate backend for the current terminal. Returns a backend instance (modern-backend or simple-backend). Result is cached in *detected-backend* for subsequent calls." (or *detected-backend* (setf *detected-backend* (if (and (detect-backend-by-tty) (or (eql (detect-backend-by-env) :modern) (detect-backend-by-da1))) (make-modern-backend) (make-simple-backend)))))