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")