1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
;; Copyright (c) 2013-2025 by Greg Hendershott.
;; SPDX-License-Identifier: GPL-3.0-or-later
#lang racket/base
;; Portions Copyright (C) 2012 Jose Antonio Ortega Ruiz.
;; Limit imports to those supplied by Minimal Racket!
(require file/convertible
racket/file
racket/format
racket/match)
(provide set-use-svg?!
convert-image)
;; Emacs front end tells us whether SVG is an image file type Emacs
;; can render. This comes via a command line flag when we start up.
(define use-svg? #t)
(define (set-use-svg?! v) (set! use-svg? v))
;; For a given value, pretty-print-size-hook can be called multiple
;; times (!) followed once by pretty-print-print-hook. So because
;; convert-and-save does non-trivial work, we cache.
(define ht (make-weak-hasheq)) ;weak because #624
(define (convert-image v #:remove-from-cache? [remove? #f])
(and (convertible? v)
(begin0 (hash-ref! ht v
(λ () (raw-convert-image v)))
(when remove?
(hash-remove! ht v)))))
(define (raw-convert-image v)
;; Rationale for the order here:
;;
;; - Try bounded before unbounded flavors. Because we want
;; accurate image width, if available, for pretty-printing.
;;
;; - Within each flavor: Try svg (if this Emacs can use it)
;; before png. Because space.
(define fmts/exts (if use-svg?
'((svg-bytes+bounds8 "svg")
(png-bytes+bounds8 "png")
(svg-bytes+bounds "svg")
(png-bytes+bounds "png")
(svg-bytes "svg")
(png-bytes "png"))
'((png-bytes+bounds8 "png")
(png-bytes+bounds "png")
(png-bytes "png"))))
(for/or ([fmt/ext (in-list fmts/exts)])
(apply convert-and-save v fmt/ext)))
(define (convert-and-save v fmt ext)
(define (default-width _) 4096)
(match (convert v fmt #f)
[(or (list* (? bytes? bstr) width _) ;bytes+bounds
(and (? bytes? bstr) (app default-width width))) ;bytes
(define filename (make-temporary-file (~a "racket-image-~a." ext)))
(with-output-to-file filename #:exists 'truncate (λ () (display bstr)))
(cons (path->string filename) width)]
[#f #f]))
|
