[nongnu] elpa/geiser-racket 3079c3a 163/191: Racket: displaying graphics in structured objects

[Philip Kaludercic]

branch: elpa/geiser-racket
commit 3079c3a163ae68378f93f163c92d284c2e4d365b
Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
Commit: Jose Antonio Ortega Ruiz <jao@gnu.org>

    Racket: displaying graphics in structured objects
    
    By hooking the pretty-printer, as discovered by Greg in issue #49.  To
    attain nirvana, we would still need (display (list graph)) to work...
---
 geiser/images.rkt | 15 ++++++++++++++-
 geiser/user.rkt   |  8 ++++++--
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/geiser/images.rkt b/geiser/images.rkt
index 2cdcadb..b97546f 100644
--- a/geiser/images.rkt
+++ b/geiser/images.rkt
@@ -17,7 +17,9 @@
 (provide image-cache
          maybe-print-image
          maybe-write-image
-         make-port-print-handler)
+         make-port-print-handler
+         make-pretty-print-size-hook
+         make-pretty-print-print-hook)
 
 (define image-cache
   (let ([ensure-dir (lambda (dir)
@@ -51,3 +53,14 @@
 (define (make-port-print-handler ph)
   (lambda (value port . rest)
     (apply ph (or (maybe-save-image value) value) port rest)))
+
+(define (make-pretty-print-size-hook [orig (pretty-print-size-hook)])
+  (lambda (value display? port)
+    (if (convertible? value)
+        (pretty-print-columns)
+        (orig value display? port))))
+
+(define (make-pretty-print-print-hook [orig (pretty-print-print-hook)])
+  (lambda (value display? port)
+    (let [(img (maybe-save-image value))]
+      (if img (print img port) (orig value display? port)))))
diff --git a/geiser/user.rkt b/geiser/user.rkt
index c566309..b936219 100644
--- a/geiser/user.rkt
+++ b/geiser/user.rkt
@@ -126,7 +126,9 @@
 (define (install-print-handlers)
   (for-each install-print-handler (list port-print-handler
                                         port-write-handler
-                                        port-display-handler)))
+                                        port-display-handler))
+  (pretty-print-print-hook (make-pretty-print-print-hook))
+  (pretty-print-size-hook (make-pretty-print-size-hook)))
 
 (define (init-geiser-repl)
   (compile-enforce-module-constants #f)
@@ -143,7 +145,9 @@
                  (current-error-port out)
                  (current-load/use-compiled (geiser-loader))
                  (current-prompt-read (geiser-prompt-read geiser-prompt))
-                 (current-print maybe-print-image)]
+                 (current-print maybe-print-image)
+                 (pretty-print-print-hook (make-pretty-print-print-hook))
+                 (pretty-print-size-hook (make-pretty-print-size-hook))]
     (install-print-handlers)
     (preload-help)
     (read-eval-print-loop)))