189 lines
9.5 KiB
Common Lisp
189 lines
9.5 KiB
Common Lisp
(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 *standard-output*)
|
|
(force-output *standard-output*)
|
|
(sleep timeout)
|
|
(let ((response (make-array 0 :element-type 'character
|
|
:fill-pointer 0 :adjustable t)))
|
|
(loop while (listen *standard-input*)
|
|
do (vector-push-extend (read-char-no-hang *standard-input*) 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)))))
|
|
|
|
(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 *standard-output*)
|
|
(force-output *standard-output*)
|
|
(sleep timeout)
|
|
(let ((response (make-array 0 :element-type 'character
|
|
:fill-pointer 0 :adjustable t)))
|
|
(loop while (listen *standard-input*)
|
|
do (vector-push-extend (read-char-no-hang *standard-input*) 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)))))
|
|
|
|
(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 *standard-output*)
|
|
(force-output *standard-output*)
|
|
(sleep timeout)
|
|
(let ((response (make-array 0 :element-type 'character
|
|
:fill-pointer 0 :adjustable t)))
|
|
(loop while (listen *standard-input*)
|
|
do (vector-push-extend (read-char-no-hang *standard-input*) 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)))))
|