scheme/racket/geiser/images.rkt

   1 ;;; images.rkt -- support for image handline
   2
   3 ;; Copyright (C) 2012 Jose Antonio Ortega Ruiz
   4
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the Modified BSD License. You should
   7 ;; have received a copy of the license along with this program. If
   8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   9
  10 ;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org>
  11 ;; Start date: Sun Sep 2, 2012 18:54
  12
  13
  14 #lang racket/base
  15
  16 (require racket/file file/convertible racket/pretty)
  17 (provide image-cache maybe-print-image maybe-write-image)
  18
  19 (define image-cache
  20   (let ([ensure-dir (lambda (dir)
  21                       (if (path-string? dir)
  22                           (begin (make-directory* dir)
  23                                  (if (path? dir) (path->string dir) dir))
  24                           (path->string (find-system-path 'temp-dir))))])
  25     (make-parameter (ensure-dir #f) ensure-dir)))
  26
  27 (define (save-tmpimage imgbytes)
  28   ;; Save imgbytes to a new temporary file and return the filename
  29   (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache)))
  30   (with-output-to-file filename #:exists 'truncate
  31                        (lambda () (display imgbytes)))
  32   (format "#<Image: ~a>" filename))
  33
  34 (define (maybe-save-image value)
  35   (and (convertible? value)
  36        ;; (The above could be problematic if a future version of racket
  37        ;; suddenly decides it can "convert" strings to picts)
  38        (save-tmpimage (convert value 'png-bytes))))
  39
  40 (define (maybe-print-image value)
  41   (cond [(maybe-save-image value) => (lambda (s) (printf "~a\n" s))]
  42         [else (unless (void? value)
  43                 (pretty-print value))]))
  44
  45 (define (maybe-write-image value)
  46   (write (or (maybe-save-image value) value)))