From a23fdb77964ac7bf25b2f9d5239058dc7c5e6044 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay.mccarthy@gmail.com>
Date: Sat, 8 Dec 2018 21:52:24 -0500
Subject: [PATCH] Add kitty stuff (wip)

---
 kitty-init.rkt |  7 +++++++
 kitty.rkt      | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++
 t/kitty.rkt    | 31 +++++++++++++++++++++++++++++
 3 files changed, 91 insertions(+)
 create mode 100644 kitty-init.rkt
 create mode 100644 kitty.rkt
 create mode 100644 t/kitty.rkt

diff --git a/kitty-init.rkt b/kitty-init.rkt
new file mode 100644
index 0000000..19d9d94
--- /dev/null
+++ b/kitty-init.rkt
@@ -0,0 +1,7 @@
+#lang racket/base
+(require racket/init
+         raart/kitty)
+
+(install-kitty-print!)
+
+(provide (all-from-out racket/init))
diff --git a/kitty.rkt b/kitty.rkt
new file mode 100644
index 0000000..97ab3ad
--- /dev/null
+++ b/kitty.rkt
@@ -0,0 +1,53 @@
+#lang racket/base
+(require racket/match
+         (prefix-in pict: pict)
+         file/convertible
+         racket/class
+         racket/gui/base)
+
+(define (convert->png-bytes v)
+  (and (convertible? v)
+       (convert v 'png-bytes+bounds #f)))
+
+(define (snip? v) (is-a? v snip%))
+
+;; Replace "racket -t file"
+;; with
+;; "racket -I raart/kitty-init -i -t file -e '(exit 0)'"
+
+(define (install-kitty-print!)
+  (define t (environment-variables-ref (current-environment-variables) #"TERM"))
+  (when (equal? t #"xterm-kitty")
+    ;; XXX This could do better and use
+    #;(pretty-print-size-hook)
+    ;; and
+    #;(pretty-print-print-hook)
+    ;; to pretty these things inside other structures
+    ;; but, then I believe I could not rely on icat, but I'd have to implement it myself
+
+    (define old-print (current-print))
+    (define (new-print v)
+      (match (or (convert->png-bytes v) v)
+        [(list bs w h d v)
+         (define-values
+           (sp stdout stdin stderr)
+           (subprocess (current-output-port) #f (current-error-port)
+                       (find-executable-path "kitty")
+                       "+kitten" "icat"))
+         (write-bytes bs stdin)
+         (close-output-port stdin)
+         (subprocess-wait sp)]
+        [(? snip?)
+         (define wb (box #f))
+         (define hb (box #f))
+         (send v get-extent (pict:dc-for-text-size) 0 0 wb hb)
+         (define w (unbox wb))
+         (define h (unbox hb))
+         (new-print
+          (pict:dc (λ (dc x y)
+                     (send v draw dc x y 0 0 w h 0 0 'no-caret))
+                   w h))]
+        [v (old-print v)]))
+    (current-print new-print)))
+
+(provide install-kitty-print!)
diff --git a/t/kitty.rkt b/t/kitty.rkt
new file mode 100644
index 0000000..c9aa24d
--- /dev/null
+++ b/t/kitty.rkt
@@ -0,0 +1,31 @@
+#lang racket/base
+
+(define p
+  (let ()
+    (local-require pict)
+    (disk 40 #:color "Chartreuse" #:border-color "Medium Aquamarine" #:border-width 5)))
+
+(define i
+  (let ()
+    (local-require 2htdp/image)
+    (add-line
+     (rectangle 100 100 "solid" "darkolivegreen")
+     25 25 75 75
+     (make-pen "goldenrod" 30 "solid" "round" "round"))))
+
+(define pl
+  (let ()
+    (local-require plot racket/math racket/class racket/gui/base file/convertible)
+    (define r (plot (function sin (- pi) pi #:label "y = sin(x)")))
+    (displayln (vector (convertible? r) (is-a? r snip%)))
+    r))
+
+"Not convertible"
+1
+(list "foo" "bar")
+p
+(list "foo" p "bar")
+i
+(list "foo" i "bar")
+pl
+(list "foo" pl "bar")