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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
;; Copyright (c) 2013-2022 by Greg Hendershott.
;; SPDX-License-Identifier: GPL-3.0-or-later
#lang racket/base
(require racket/contract
racket/match
racket/port
racket/set
syntax/parse/define
"safe-dynamic-require.rkt")
(define number-markup?
(safe-dynamic-require 'simple-tree-text-markup/data 'number-markup?
(λ () (λ _ #f))))
(define number-markup-number
(safe-dynamic-require 'simple-tree-text-markup/data 'number-markup-number
(λ () (λ _ 0))))
(provide elisp-read
elisp-bool/c
as-racket-bool
with-parens
elisp-write
elisp-writeln)
;;; Read a subset of Emacs Lisp values as Racket values
(define (elisp-read in)
(elisp->racket (read in)))
(define (elisp->racket v)
(match v
['nil '()] ;not #f -- see as-racket-bool
['t #t]
[(? list? xs) (map elisp->racket xs)]
[(cons x y) (cons (elisp->racket x) (elisp->racket y))]
[(vector s _ ...) s] ;Emacs strings can be #("string" . properties)
[v v]))
(define elisp-bool/c (or/c #t '()))
(define (as-racket-bool v)
;; elisp->racket "de-puns" 'nil as '() -- not #f. Use this helper when
;; instead you want to treat it as a boolean and get #f.
(and v (not (null? v))))
;;; Write a subset of Racket values as Emacs Lisp values
(define (elisp-writeln v)
(elisp-write v)
(newline))
(define-simple-macro (with-parens e:expr ...+)
(begin (display "(")
e ...
(display ")")))
(define (elisp-write v)
(match v
[(or #f (list)) (write 'nil)]
[#t (write 't)]
[(? list? xs) (with-parens
(for-each (λ (v)
(elisp-write v)
(display " "))
xs))]
[(cons x y) (with-parens
(elisp-write x)
(display " . ")
(elisp-write y))]
[(? path? v) (elisp-write (path->string v))]
[(? hash? v) (with-parens
(hash-for-each v
(λ (k v)
(elisp-write (cons k v))
(display " "))))]
[(? generic-set? v) (with-parens
(set-for-each v
(λ (v)
(elisp-write v)
(display " "))))]
[(? void?) (display "void")] ;avoid Elisp-unreadable "#<void>"
[(? procedure? w) (w)]
[(or (? number? v)
(? symbol? v)
(? string? v)) (write v)]
[(? bytes? bstr) (write (bytes->string/utf-8 bstr))] ; ???
;; #731: htdp/bsl assumes port-writes-special? means it can write
;; number-markup structs. It ought not to, but accomodate here.
;; Note: See gui.rkt for namespace-attach-module of
;; simple-tree-text-markup/data, necessary because generative
;; structs.
[(? number-markup? m) (write (number-markup-number m))]
[v (write (format "~s" v))]))
(module+ test
(require rackunit)
(check-equal? (with-output-to-string
(λ () (elisp-write '(1 #t nil () (a . b) #hash((1 . 2) (3 . 4))))))
"(1 t nil nil (a . b) ((1 . 2) (3 . 4) ) )"))
|
