Artifact
55242f150ce1ff833051d9904e9c225517269da4:
- File
cairo/parse-json.ss
— part of check-in
[342d9b1e94]
at
2016-12-15 01:14:13
on branch trunk
— cairo ffi improvements
(user:
aldo
size: 5043)
0000: 3b 3b 0a 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 ;;.;; Copyright
0010: 32 30 31 36 20 41 6c 64 6f 20 4e 69 63 6f 6c 61 2016 Aldo Nicola
0020: 73 20 42 72 75 6e 6f 0a 3b 3b 0a 3b 3b 20 4c 69 s Bruno.;;.;; Li
0030: 63 65 6e 73 65 64 20 75 6e 64 65 72 20 74 68 65 censed under the
0040: 20 41 70 61 63 68 65 20 4c 69 63 65 6e 73 65 2c Apache License,
0050: 20 56 65 72 73 69 6f 6e 20 32 2e 30 20 28 74 68 Version 2.0 (th
0060: 65 20 22 4c 69 63 65 6e 73 65 22 29 3b 0a 3b 3b e "License");.;;
0070: 20 79 6f 75 20 6d 61 79 20 6e 6f 74 20 75 73 65 you may not use
0080: 20 74 68 69 73 20 66 69 6c 65 20 65 78 63 65 70 this file excep
0090: 74 20 69 6e 20 63 6f 6d 70 6c 69 61 6e 63 65 20 t in compliance
00a0: 77 69 74 68 20 74 68 65 20 4c 69 63 65 6e 73 65 with the License
00b0: 2e 0a 3b 3b 20 59 6f 75 20 6d 61 79 20 6f 62 74 ..;; You may obt
00c0: 61 69 6e 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ain a copy of th
00d0: 65 20 4c 69 63 65 6e 73 65 20 61 74 0a 3b 3b 0a e License at.;;.
00e0: 3b 3b 20 20 20 20 20 68 74 74 70 3a 2f 2f 77 77 ;; http://ww
00f0: 77 2e 61 70 61 63 68 65 2e 6f 72 67 2f 6c 69 63 w.apache.org/lic
0100: 65 6e 73 65 73 2f 4c 49 43 45 4e 53 45 2d 32 2e enses/LICENSE-2.
0110: 30 0a 3b 3b 0a 3b 3b 20 55 6e 6c 65 73 73 20 72 0.;;.;; Unless r
0120: 65 71 75 69 72 65 64 20 62 79 20 61 70 70 6c 69 equired by appli
0130: 63 61 62 6c 65 20 6c 61 77 20 6f 72 20 61 67 72 cable law or agr
0140: 65 65 64 20 74 6f 20 69 6e 20 77 72 69 74 69 6e eed to in writin
0150: 67 2c 20 73 6f 66 74 77 61 72 65 0a 3b 3b 20 64 g, software.;; d
0160: 69 73 74 72 69 62 75 74 65 64 20 75 6e 64 65 72 istributed under
0170: 20 74 68 65 20 4c 69 63 65 6e 73 65 20 69 73 20 the License is
0180: 64 69 73 74 72 69 62 75 74 65 64 20 6f 6e 20 61 distributed on a
0190: 6e 20 22 41 53 20 49 53 22 20 42 41 53 49 53 2c n "AS IS" BASIS,
01a0: 0a 3b 3b 20 57 49 54 48 4f 55 54 20 57 41 52 52 .;; WITHOUT WARR
01b0: 41 4e 54 49 45 53 20 4f 52 20 43 4f 4e 44 49 54 ANTIES OR CONDIT
01c0: 49 4f 4e 53 20 4f 46 20 41 4e 59 20 4b 49 4e 44 IONS OF ANY KIND
01d0: 2c 20 65 69 74 68 65 72 20 65 78 70 72 65 73 73 , either express
01e0: 20 6f 72 20 69 6d 70 6c 69 65 64 2e 0a 3b 3b 20 or implied..;;
01f0: 53 65 65 20 74 68 65 20 4c 69 63 65 6e 73 65 20 See the License
0200: 66 6f 72 20 74 68 65 20 73 70 65 63 69 66 69 63 for the specific
0210: 20 6c 61 6e 67 75 61 67 65 20 67 6f 76 65 72 6e language govern
0220: 69 6e 67 20 70 65 72 6d 69 73 73 69 6f 6e 73 20 ing permissions
0230: 61 6e 64 0a 3b 3b 20 6c 69 6d 69 74 61 74 69 6f and.;; limitatio
0240: 6e 73 20 75 6e 64 65 72 20 74 68 65 20 4c 69 63 ns under the Lic
0250: 65 6e 73 65 2e 0a 0a 28 69 6d 70 6f 72 74 20 28 ense...(import (
0260: 73 63 68 65 6d 65 29 0a 09 28 6a 73 6f 6e 29 29 scheme)..(json))
0270: 0a 0a 28 69 6d 70 6f 72 74 20 28 6f 6e 6c 79 20 ..(import (only
0280: 28 74 68 75 6e 64 65 72 2d 75 74 69 6c 73 29 20 (thunder-utils)
0290: 73 74 72 69 6e 67 2d 72 65 70 6c 61 63 65 20 73 string-replace s
02a0: 74 72 69 6e 67 2d 73 70 6c 69 74 29 20 0a 09 28 tring-split) ..(
02b0: 6f 6e 6c 79 20 28 73 72 66 69 20 73 31 33 20 73 only (srfi s13 s
02c0: 74 72 69 6e 67 73 29 20 73 74 72 69 6e 67 2d 64 trings) string-d
02d0: 72 6f 70 20 73 74 72 69 6e 67 2d 64 6f 77 6e 63 rop string-downc
02e0: 61 73 65 20 73 74 72 69 6e 67 2d 70 72 65 66 69 ase string-prefi
02f0: 78 3f 20 73 74 72 69 6e 67 2d 73 75 66 66 69 78 x? string-suffix
0300: 3f 20 73 74 72 69 6e 67 2d 64 65 6c 65 74 65 29 ? string-delete)
0310: 0a 09 28 6f 6e 6c 79 20 28 73 72 66 69 20 73 31 ..(only (srfi s1
0320: 20 6c 69 73 74 73 29 20 66 6f 6c 64 29 0a 09 28 lists) fold)..(
0330: 73 72 66 69 20 73 31 34 20 63 68 61 72 2d 73 65 srfi s14 char-se
0340: 74 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 61 ts))..(define (a
0350: 6e 74 69 2d 63 61 6d 65 6c 20 78 29 0a 20 20 28 nti-camel x). (
0360: 6c 65 74 2a 20 28 5b 78 20 28 73 74 72 69 6e 67 let* ([x (string
0370: 2d 72 65 70 6c 61 63 65 20 78 20 23 5c 5f 20 23 -replace x #\_ #
0380: 5c 2d 29 5d 0a 09 20 5b 6c 65 6e 20 28 73 74 72 \-)].. [len (str
0390: 69 6e 67 2d 6c 65 6e 67 74 68 20 78 29 5d 0a 09 ing-length x)]..
03a0: 20 5b 66 20 28 6c 61 6d 62 64 61 20 28 73 20 6c [f (lambda (s l
03b0: 65 6e 29 0a 09 20 20 20 20 20 20 28 6c 69 73 74 en).. (list
03c0: 2d 3e 73 74 72 69 6e 67 0a 09 20 20 20 20 20 20 ->string..
03d0: 20 28 72 65 76 65 72 73 65 0a 09 09 28 66 6f 6c (reverse...(fol
03e0: 64 20 28 6c 61 6d 62 64 61 20 28 69 20 61 63 63 d (lambda (i acc
03f0: 29 20 0a 09 09 09 28 6c 65 74 20 28 5b 61 20 28 ) ....(let ([a (
0400: 73 74 72 69 6e 67 2d 72 65 66 20 73 20 69 29 5d string-ref s i)]
0410: 20 0a 09 09 09 20 20 20 20 20 20 5b 6e 65 78 74 .... [next
0420: 20 28 69 66 20 28 3c 20 28 2b 20 31 20 69 29 20 (if (< (+ 1 i)
0430: 6c 65 6e 29 20 28 73 74 72 69 6e 67 2d 72 65 66 len) (string-ref
0440: 20 73 20 28 2b 20 31 20 69 29 29 20 23 66 29 5d s (+ 1 i)) #f)]
0450: 0a 09 09 09 20 20 20 20 20 20 5b 70 72 65 76 20 .... [prev
0460: 28 69 66 20 28 3e 20 69 20 30 29 20 28 73 74 72 (if (> i 0) (str
0470: 69 6e 67 2d 72 65 66 20 73 20 28 2d 20 69 20 31 ing-ref s (- i 1
0480: 29 29 20 23 66 29 5d 29 0a 09 09 09 20 20 28 69 )) #f)]).... (i
0490: 66 20 28 61 6e 64 20 28 63 68 61 72 2d 75 70 70 f (and (char-upp
04a0: 65 72 2d 63 61 73 65 3f 20 61 29 20 20 6e 65 78 er-case? a) nex
04b0: 74 20 70 72 65 76 0a 09 09 09 09 20 20 20 28 6e t prev..... (n
04c0: 6f 74 20 0a 09 09 09 09 20 20 20 20 28 6f 72 20 ot ..... (or
04d0: 28 63 68 61 72 3d 3f 20 61 20 23 5c 2d 29 20 28 (char=? a #\-) (
04e0: 63 68 61 72 3d 3f 20 70 72 65 76 20 23 5c 2d 29 char=? prev #\-)
04f0: 20 28 63 68 61 72 3d 3f 20 6e 65 78 74 20 23 5c (char=? next #\
0500: 2d 29 0a 09 09 09 09 09 28 61 6e 64 20 28 63 68 -)......(and (ch
0510: 61 72 2d 75 70 70 65 72 2d 63 61 73 65 3f 20 6e ar-upper-case? n
0520: 65 78 74 29 20 28 63 68 61 72 2d 75 70 70 65 72 ext) (char-upper
0530: 2d 63 61 73 65 3f 20 70 72 65 76 29 29 29 29 29 -case? prev)))))
0540: 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e 73 20 .... (cons
0550: 28 63 68 61 72 2d 64 6f 77 6e 63 61 73 65 20 61 (char-downcase a
0560: 29 20 28 63 6f 6e 73 20 23 5c 2d 20 61 63 63 29 ) (cons #\- acc)
0570: 29 0a 09 09 09 20 20 20 20 20 20 28 63 6f 6e 73 ).... (cons
0580: 20 28 63 68 61 72 2d 64 6f 77 6e 63 61 73 65 20 (char-downcase
0590: 61 29 20 61 63 63 29 29 29 29 20 27 28 29 20 28 a) acc)))) '() (
05a0: 69 6f 74 61 20 6c 65 6e 29 29 29 29 29 5d 29 0a iota len)))))]).
05b0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 5b (cond. [
05c0: 23 66 20 23 66 5d 0a 20 20 20 20 20 5b 65 6c 73 #f #f]. [els
05d0: 65 20 28 66 20 78 20 6c 65 6e 29 5d 29 29 29 0a e (f x len)]))).
05e0: 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d 74 20 .(define (add-t
05f0: 78 29 0a 20 20 28 6c 65 74 20 28 5b 78 64 20 28 x). (let ([xd (
0600: 73 74 72 69 6e 67 2d 64 6f 77 6e 63 61 73 65 20 string-downcase
0610: 78 29 5d 29 0a 20 20 20 20 28 69 66 20 28 61 6e x)]). (if (an
0620: 64 20 28 73 74 72 69 6e 67 2d 70 72 65 66 69 78 d (string-prefix
0630: 3f 20 22 63 61 69 72 6f 2d 22 20 78 64 29 20 0a ? "cairo-" xd) .
0640: 09 20 20 20 20 20 28 6e 6f 74 20 20 28 6f 72 20 . (not (or
0650: 28 73 74 72 69 6e 67 2d 73 75 66 66 69 78 3f 20 (string-suffix?
0660: 22 2a 22 20 78 29 20 28 73 74 72 69 6e 67 2d 73 "*" x) (string-s
0670: 75 66 66 69 78 3f 20 22 2d 74 22 20 78 29 29 29 uffix? "-t" x)))
0680: 29 0a 09 28 73 74 72 69 6e 67 2d 61 70 70 65 6e )..(string-appen
0690: 64 20 78 20 22 2d 74 22 29 0a 09 78 29 29 29 0a d x "-t")..x))).
06a0: 0a 28 64 65 66 69 6e 65 20 28 61 64 64 2d 2a 20 .(define (add-*
06b0: 78 29 0a 20 20 28 73 74 72 69 6e 67 2d 61 70 70 x). (string-app
06c0: 65 6e 64 20 78 20 22 2a 22 29 29 0a 0a 28 64 65 end x "*"))..(de
06d0: 66 69 6e 65 20 28 73 79 6d 62 6f 6c 2d 61 70 70 fine (symbol-app
06e0: 65 6e 64 20 2e 20 73 79 6d 62 6f 6c 73 29 0a 20 end . symbols).
06f0: 20 28 61 70 70 6c 79 20 73 74 72 69 6e 67 2d 61 (apply string-a
0700: 70 70 65 6e 64 20 28 6d 61 70 20 73 79 6d 62 6f ppend (map symbo
0710: 6c 2d 3e 73 74 72 69 6e 67 20 73 79 6d 62 6f 6c l->string symbol
0720: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 s)))..(define (d
0730: 65 63 6f 64 65 2d 74 79 70 65 20 74 29 0a 20 20 ecode-type t).
0740: 28 69 66 20 74 0a 20 20 20 20 20 20 28 6c 65 74 (if t. (let
0750: 2d 6a 73 6f 6e 2d 6f 62 6a 65 63 74 20 74 20 28 -json-object t (
0760: 74 61 67 20 74 79 70 65 29 0a 09 09 20 20 20 20 tag type)...
0770: 20 20 20 28 6c 65 74 20 28 5b 74 61 67 2a 20 28 (let ([tag* (
0780: 69 66 20 28 73 74 72 69 6e 67 3f 20 74 61 67 29 if (string? tag)
0790: 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c (string->symbol
07a0: 20 74 61 67 29 20 74 61 67 29 5d 29 0a 09 09 09 tag) tag)])....
07b0: 20 28 63 61 73 65 20 74 61 67 2a 0a 09 09 09 20 (case tag*....
07c0: 20 20 5b 3a 66 75 6e 63 74 69 6f 6e 2d 70 6f 69 [:function-poi
07d0: 6e 74 65 72 20 27 76 6f 69 64 2a 5d 0a 09 09 09 nter 'void*]....
07e0: 20 20 20 5b 3a 69 6e 74 20 27 69 6e 74 5d 0a 09 [:int 'int]..
07f0: 09 09 20 20 20 5b 3a 75 6e 73 69 67 6e 65 64 2d .. [:unsigned-
0800: 69 6e 74 20 27 75 6e 73 69 67 6e 65 64 2d 69 6e int 'unsigned-in
0810: 74 5d 0a 09 09 09 20 20 20 5b 3a 75 6e 73 69 67 t].... [:unsig
0820: 6e 65 64 2d 6c 6f 6e 67 2d 6c 6f 6e 67 20 27 75 ned-long-long 'u
0830: 6e 73 69 67 6e 65 64 2d 6c 6f 6e 67 2d 6c 6f 6e nsigned-long-lon
0840: 67 5d 0a 09 09 09 20 20 20 5b 3a 75 6e 73 69 67 g].... [:unsig
0850: 6e 65 64 2d 6c 6f 6e 67 20 27 75 6e 73 69 67 6e ned-long 'unsign
0860: 65 64 2d 6c 6f 6e 67 5d 0a 09 09 09 20 20 20 5b ed-long].... [
0870: 3a 6c 6f 6e 67 20 27 6c 6f 6e 67 5d 0a 09 09 09 :long 'long]....
0880: 20 20 20 5b 3a 64 6f 75 62 6c 65 20 27 64 6f 75 [:double 'dou
0890: 62 6c 65 5d 0a 09 09 09 20 20 20 5b 3a 6c 6f 6e ble].... [:lon
08a0: 67 2d 64 6f 75 62 6c 65 20 27 6c 6f 6e 67 2d 64 g-double 'long-d
08b0: 6f 75 62 6c 65 5d 0a 09 09 09 20 20 20 5b 3a 66 ouble].... [:f
08c0: 6c 6f 61 74 20 27 66 6c 6f 61 74 5d 0a 09 09 09 loat 'float]....
08d0: 20 20 20 5b 3a 70 6f 69 6e 74 65 72 20 28 6c 65 [:pointer (le
08e0: 74 20 28 5b 70 74 20 28 64 65 63 6f 64 65 2d 74 t ([pt (decode-t
08f0: 79 70 65 20 74 79 70 65 29 5d 29 0a 09 09 09 09 ype type)]).....
0900: 20 20 20 20 20 20 20 28 63 61 73 65 20 70 74 0a (case pt.
0910: 09 09 09 09 09 20 28 63 68 61 72 20 27 73 74 72 ..... (char 'str
0920: 69 6e 67 29 0a 09 09 09 09 09 20 28 76 6f 69 64 ing)...... (void
0930: 20 27 76 6f 69 64 2a 29 0a 09 09 09 09 09 20 28 'void*)...... (
0940: 65 6c 73 65 0a 09 09 09 09 09 20 20 28 69 66 20 else...... (if
0950: 28 61 6e 64 20 28 70 61 69 72 3f 20 70 74 20 29 (and (pair? pt )
0960: 20 28 65 71 3f 20 28 63 61 72 20 70 74 29 20 27 (eq? (car pt) '
0970: 2a 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 60 *))...... `
0980: 28 2a 20 2c 28 73 79 6d 62 6f 6c 2d 61 70 70 65 (* ,(symbol-appe
0990: 6e 64 20 28 63 61 64 72 20 70 74 29 20 27 2a 29 nd (cadr pt) '*)
09a0: 29 20 3b 3b 20 44 4f 55 42 4c 45 20 53 54 41 52 ) ;; DOUBLE STAR
09b0: 20 53 45 45 4d 53 20 4e 4f 54 20 53 55 50 50 4f SEEMS NOT SUPPO
09c0: 52 54 45 44 20 4f 4e 20 43 48 45 5a 0a 09 09 09 RTED ON CHEZ....
09d0: 09 09 20 20 20 20 20 20 60 28 2a 20 2c 70 74 29 .. `(* ,pt)
09e0: 29 0a 09 09 09 09 09 20 20 23 3b 28 73 74 72 69 )...... #;(stri
09f0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 0a 09 09 09 09 ng->symbol .....
0a00: 09 20 20 20 28 61 64 64 2d 2a 0a 09 09 09 09 09 . (add-*......
0a10: 20 20 20 20 28 73 79 6d 62 6f 6c 2d 3e 73 74 72 (symbol->str
0a20: 69 6e 67 20 70 74 29 29 29 29 29 29 5d 0a 09 09 ing pt))))))]...
0a30: 09 20 20 20 5b 3a 76 6f 69 64 20 27 76 6f 69 64 . [:void 'void
0a40: 5d 0a 09 09 09 20 20 20 5b 3a 63 68 61 72 20 27 ].... [:char '
0a50: 63 68 61 72 5d 0a 09 09 09 20 20 20 5b 3a 75 6e char].... [:un
0a60: 73 69 67 6e 65 64 2d 63 68 61 72 20 27 75 6e 73 signed-char 'uns
0a70: 69 67 6e 65 64 2d 38 5d 0a 09 09 09 20 20 20 5b igned-8].... [
0a80: 28 63 61 69 72 6f 5f 75 73 65 72 5f 73 63 61 6c (cairo_user_scal
0a90: 65 64 5f 66 6f 6e 74 5f 69 6e 69 74 5f 66 75 6e ed_font_init_fun
0aa0: 63 5f 74 0a 09 09 09 20 20 20 20 63 61 69 72 6f c_t.... cairo
0ab0: 5f 75 73 65 72 5f 73 63 61 6c 65 64 5f 66 6f 6e _user_scaled_fon
0ac0: 74 5f 72 65 6e 64 65 72 5f 67 6c 79 70 68 5f 66 t_render_glyph_f
0ad0: 75 6e 63 5f 74 0a 09 09 09 20 20 20 20 63 61 69 unc_t.... cai
0ae0: 72 6f 5f 75 73 65 72 5f 73 63 61 6c 65 64 5f 66 ro_user_scaled_f
0af0: 6f 6e 74 5f 74 65 78 74 5f 74 6f 5f 67 6c 79 70 ont_text_to_glyp
0b00: 68 73 5f 66 75 6e 63 5f 74 0a 09 09 09 20 20 20 hs_func_t....
0b10: 20 63 61 69 72 6f 5f 75 73 65 72 5f 73 63 61 6c cairo_user_scal
0b20: 65 64 5f 66 6f 6e 74 5f 75 6e 69 63 6f 64 65 5f ed_font_unicode_
0b30: 74 6f 5f 67 6c 79 70 68 5f 66 75 6e 63 5f 74 0a to_glyph_func_t.
0b40: 09 09 09 20 20 20 20 63 61 69 72 6f 5f 73 75 72 ... cairo_sur
0b50: 66 61 63 65 5f 6f 62 73 65 72 76 65 72 5f 63 61 face_observer_ca
0b60: 6c 6c 62 61 63 6b 5f 74 0a 09 09 09 20 20 20 20 llback_t....
0b70: 63 61 69 72 6f 5f 77 72 69 74 65 5f 66 75 6e 63 cairo_write_func
0b80: 5f 74 0a 09 09 09 20 20 20 20 63 61 69 72 6f 5f _t.... cairo_
0b90: 72 65 61 64 5f 66 75 6e 63 5f 74 0a 09 09 09 20 read_func_t....
0ba0: 20 20 20 63 61 69 72 6f 5f 72 61 73 74 65 72 5f cairo_raster_
0bb0: 73 6f 75 72 63 65 5f 72 65 6c 65 61 73 65 5f 66 source_release_f
0bc0: 75 6e 63 5f 74 0a 09 09 09 20 20 20 20 63 61 69 unc_t.... cai
0bd0: 72 6f 5f 72 61 73 74 65 72 5f 73 6f 75 72 63 65 ro_raster_source
0be0: 5f 61 63 71 75 69 72 65 5f 66 75 6e 63 5f 74 0a _acquire_func_t.
0bf0: 09 09 09 20 20 20 20 63 61 69 72 6f 5f 72 61 73 ... cairo_ras
0c00: 74 65 72 5f 73 6f 75 72 63 65 5f 73 6e 61 70 73 ter_source_snaps
0c10: 68 6f 74 5f 66 75 6e 63 5f 74 0a 09 09 09 20 20 hot_func_t....
0c20: 20 20 63 61 69 72 6f 5f 72 61 73 74 65 72 5f 73 cairo_raster_s
0c30: 6f 75 72 63 65 5f 63 6f 70 79 5f 66 75 6e 63 5f ource_copy_func_
0c40: 74 0a 09 09 09 20 20 20 20 63 61 69 72 6f 5f 72 t.... cairo_r
0c50: 61 73 74 65 72 5f 73 6f 75 72 63 65 5f 66 69 6e aster_source_fin
0c60: 69 73 68 5f 66 75 6e 63 5f 74 29 0a 09 09 09 20 ish_func_t)....
0c70: 20 20 20 60 28 2a 20 2c 28 73 74 72 69 6e 67 2d `(* ,(string-
0c80: 3e 73 79 6d 62 6f 6c 20 28 73 74 72 69 6e 67 2d >symbol (string-
0c90: 72 65 70 6c 61 63 65 20 28 73 79 6d 62 6f 6c 2d replace (symbol-
0ca0: 3e 73 74 72 69 6e 67 20 74 61 67 2a 29 20 23 5c >string tag*) #\
0cb0: 5f 20 23 5c 2d 29 29 29 5d 0a 09 20 20 20 20 20 _ #\-)))]..
0cc0: 0a 09 09 09 20 20 20 5b 65 6c 73 65 20 28 69 66 .... [else (if
0cd0: 20 28 73 79 6d 62 6f 6c 3f 20 74 61 67 2a 29 0a (symbol? tag*).
0ce0: 09 09 09 09 20 20 20 20 20 28 73 74 72 69 6e 67 .... (string
0cf0: 2d 3e 73 79 6d 62 6f 6c 20 0a 09 09 09 09 20 20 ->symbol .....
0d00: 20 20 20 20 28 61 64 64 2d 74 0a 09 09 09 09 20 (add-t.....
0d10: 20 20 20 20 20 20 28 61 6e 74 69 2d 63 61 6d 65 (anti-came
0d20: 6c 20 0a 09 09 09 09 09 28 73 79 6d 62 6f 6c 2d l ......(symbol-
0d30: 3e 73 74 72 69 6e 67 20 74 61 67 2a 29 29 29 29 >string tag*))))
0d40: 0a 09 09 09 09 20 20 20 20 20 74 61 67 2a 29 5d ..... tag*)]
0d50: 29 29 29 0a 20 20 20 20 20 20 23 66 29 29 0a 28 ))). #f)).(
0d60: 64 65 66 69 6e 65 20 28 64 65 63 6f 64 65 2d 70 define (decode-p
0d70: 61 72 61 6d 20 70 29 0a 20 20 28 6c 65 74 2d 6a aram p). (let-j
0d80: 73 6f 6e 2d 6f 62 6a 65 63 74 20 70 20 28 74 61 son-object p (ta
0d90: 67 20 6e 61 6d 65 20 74 79 70 65 29 0a 09 09 20 g name type)...
0da0: 20 20 28 69 66 20 28 65 71 75 61 6c 3f 20 6e 61 (if (equal? na
0db0: 6d 65 20 22 22 29 20 0a 09 09 20 20 20 20 20 20 me "") ...
0dc0: 20 28 64 65 63 6f 64 65 2d 74 79 70 65 20 74 79 (decode-type ty
0dd0: 70 65 29 0a 09 09 20 20 20 20 20 20 20 28 6c 69 pe)... (li
0de0: 73 74 20 6e 61 6d 65 20 28 64 65 63 6f 64 65 2d st name (decode-
0df0: 74 79 70 65 20 74 79 70 65 29 29 29 29 29 0a 0a type type)))))..
0e00: 0a 28 64 65 66 69 6e 65 20 63 61 69 72 6f 2d 6a .(define cairo-j
0e10: 73 6f 6e 2d 74 65 78 74 20 28 72 65 61 64 2d 66 son-text (read-f
0e20: 69 6c 65 20 22 63 61 69 72 6f 2e 6a 73 6f 6e 22 ile "cairo.json"
0e30: 29 29 0a 28 64 65 66 69 6e 65 20 63 61 69 72 6f )).(define cairo
0e40: 2d 6a 73 6f 6e 20 28 73 74 72 69 6e 67 2d 3e 6a -json (string->j
0e50: 73 6f 6e 20 63 61 69 72 6f 2d 6a 73 6f 6e 2d 74 son cairo-json-t
0e60: 65 78 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 63 ext))..(define c
0e70: 61 69 72 6f 2d 70 64 66 2d 6a 73 6f 6e 2d 74 65 airo-pdf-json-te
0e80: 78 74 20 28 72 65 61 64 2d 66 69 6c 65 20 22 63 xt (read-file "c
0e90: 61 69 72 6f 2d 70 64 66 2e 6a 73 6f 6e 22 29 29 airo-pdf.json"))
0ea0: 0a 28 64 65 66 69 6e 65 20 63 61 69 72 6f 2d 70 .(define cairo-p
0eb0: 64 66 2d 6a 73 6f 6e 20 28 73 74 72 69 6e 67 2d df-json (string-
0ec0: 3e 6a 73 6f 6e 20 63 61 69 72 6f 2d 70 64 66 2d >json cairo-pdf-
0ed0: 6a 73 6f 6e 2d 74 65 78 74 29 29 0a 0a 28 77 69 json-text))..(wi
0ee0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
0ef0: 65 20 22 63 61 69 72 6f 2e 73 65 78 70 22 20 28 e "cairo.sexp" (
0f00: 6c 61 6d 62 64 61 20 28 29 20 28 70 72 65 74 74 lambda () (prett
0f10: 79 2d 70 72 69 6e 74 20 63 61 69 72 6f 2d 6a 73 y-print cairo-js
0f20: 6f 6e 29 29 20 27 74 72 75 6e 63 61 74 65 29 0a on)) 'truncate).
0f30: 0a 28 77 69 74 68 2d 6f 75 74 70 75 74 2d 74 6f .(with-output-to
0f40: 2d 66 69 6c 65 20 22 63 61 69 72 6f 2d 70 64 66 -file "cairo-pdf
0f50: 2e 73 65 78 70 22 20 28 6c 61 6d 62 64 61 20 28 .sexp" (lambda (
0f60: 29 20 28 70 72 65 74 74 79 2d 70 72 69 6e 74 20 ) (pretty-print
0f70: 63 61 69 72 6f 2d 70 64 66 2d 6a 73 6f 6e 29 29 cairo-pdf-json))
0f80: 20 27 74 72 75 6e 63 61 74 65 29 0a 0a 28 64 65 'truncate)..(de
0f90: 66 69 6e 65 20 62 6c 61 63 6b 6c 69 73 74 20 27 fine blacklist '
0fa0: 28 29 29 0a 0a 28 69 6d 70 6f 72 74 20 28 6f 6e ())..(import (on
0fb0: 6c 79 20 28 73 72 66 69 20 73 31 33 20 73 74 72 ly (srfi s13 str
0fc0: 69 6e 67 73 29 20 73 74 72 69 6e 67 2d 63 6f 6e ings) string-con
0fd0: 74 61 69 6e 73 29 29 0a 28 64 65 66 69 6e 65 20 tains)).(define
0fe0: 28 70 61 72 73 65 2d 6a 73 6f 6e 2d 66 75 6e 63 (parse-json-func
0ff0: 74 69 6f 6e 20 78 20 6d 29 0a 20 20 28 6c 65 74 tion x m). (let
1000: 2d 6a 73 6f 6e 2d 6f 62 6a 65 63 74 20 78 20 28 -json-object x (
1010: 74 61 67 20 6e 61 6d 65 20 6c 6f 63 61 74 69 6f tag name locatio
1020: 6e 20 72 65 74 75 72 6e 2d 74 79 70 65 20 70 61 n return-type pa
1030: 72 61 6d 65 74 65 72 73 29 20 0a 09 09 20 20 20 rameters) ...
1040: 28 69 66 20 28 61 6e 64 20 20 28 6f 72 20 28 73 (if (and (or (s
1050: 74 72 69 6e 67 2d 63 6f 6e 74 61 69 6e 73 20 6c tring-contains l
1060: 6f 63 61 74 69 6f 6e 20 6d 29 20 0a 09 09 09 09 ocation m) .....
1070: 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 22 63 61 (and (equal? "ca
1080: 69 72 6f 22 20 6d 29 20 28 73 74 72 69 6e 67 2d iro" m) (string-
1090: 63 6f 6e 74 61 69 6e 73 20 6c 6f 63 61 74 69 6f contains locatio
10a0: 6e 20 22 63 61 69 72 6f 2e 68 22 29 29 29 0a 09 n "cairo.h")))..
10b0: 09 09 20 20 20 20 20 28 65 71 75 61 6c 3f 20 74 .. (equal? t
10c0: 61 67 20 22 66 75 6e 63 74 69 6f 6e 22 29 0a 09 ag "function")..
10d0: 09 09 20 20 20 20 28 73 74 72 69 6e 67 2d 70 72 .. (string-pr
10e0: 65 66 69 78 3f 20 22 63 61 69 72 6f 5f 22 20 6e efix? "cairo_" n
10f0: 61 6d 65 29 29 0a 09 09 20 20 20 20 20 20 20 28 ame))... (
1100: 63 6f 6e 64 0a 09 09 09 5b 28 6d 65 6d 71 20 28 cond....[(memq (
1110: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 string->symbol (
1120: 61 6e 74 69 2d 63 61 6d 65 6c 20 6e 61 6d 65 29 anti-camel name)
1130: 29 20 62 6c 61 63 6b 6c 69 73 74 29 0a 09 09 09 ) blacklist)....
1140: 20 28 70 72 69 6e 74 66 20 22 3b 3b 62 6c 61 63 (printf ";;blac
1150: 6b 6c 69 73 74 65 64 20 70 72 6f 62 61 62 6c 79 klisted probably
1160: 20 62 65 63 61 75 73 65 20 69 74 20 75 73 65 73 because it uses
1170: 20 61 20 73 74 72 75 63 74 20 61 73 20 76 61 6c a struct as val
1180: 75 65 2e 5c 6e 28 64 65 66 69 6e 65 20 7e 64 20 ue.\n(define ~d
1190: 23 66 29 5c 6e 22 20 28 61 6e 74 69 2d 63 61 6d #f)\n" (anti-cam
11a0: 65 6c 20 6e 61 6d 65 29 29 5d 0a 09 09 09 5b 65 el name))]....[e
11b0: 6c 73 65 0a 09 09 09 20 20 20 28 70 72 69 6e 74 lse.... (print
11c0: 66 20 22 28 64 65 66 69 6e 65 2d 63 61 69 72 6f f "(define-cairo
11d0: 2d 66 75 6e 63 20 7e 64 20 7e 64 20 7e 64 20 5c -func ~d ~d ~d \
11e0: 22 7e 64 5c 22 29 5c 6e 22 0a 09 09 09 09 20 20 "~d\")\n".....
11f0: 20 28 64 65 63 6f 64 65 2d 74 79 70 65 20 72 65 (decode-type re
1200: 74 75 72 6e 2d 74 79 70 65 29 20 0a 09 09 09 09 turn-type) .....
1210: 20 20 20 28 63 61 73 65 20 6e 61 6d 65 0a 09 09 (case name...
1220: 09 09 20 20 20 20 20 28 65 6c 73 65 20 28 61 6e .. (else (an
1230: 74 69 2d 63 61 6d 65 6c 20 6e 61 6d 65 29 29 29 ti-camel name)))
1240: 0a 09 09 09 09 20 20 20 0a 09 09 09 09 20 20 20 ..... .....
1250: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 70 29 (map (lambda (p)
1260: 20 28 64 65 63 6f 64 65 2d 70 61 72 61 6d 20 70 (decode-param p
1270: 29 29 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 )) (vector->list
1280: 20 70 61 72 61 6d 65 74 65 72 73 29 29 0a 09 09 parameters))...
1290: 09 09 20 20 20 6e 61 6d 65 29 5d 29 29 29 29 0a .. name)])))).
12a0: 0a 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 .(for-each (lamb
12b0: 64 61 20 28 6d 29 20 0a 09 20 20 20 20 28 77 69 da (m) .. (wi
12c0: 74 68 2d 6f 75 74 70 75 74 2d 74 6f 2d 66 69 6c th-output-to-fil
12d0: 65 20 28 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 e (string-append
12e0: 20 28 63 61 72 20 6d 29 20 22 2d 66 75 6e 63 74 (car m) "-funct
12f0: 69 6f 6e 73 2e 73 73 22 29 0a 09 20 20 20 20 20 ions.ss")..
1300: 20 28 6c 61 6d 62 64 61 20 28 29 20 0a 09 09 28 (lambda () ...(
1310: 76 65 63 74 6f 72 2d 66 6f 72 2d 65 61 63 68 20 vector-for-each
1320: 0a 09 09 20 28 6c 61 6d 62 64 61 20 28 78 29 20 ... (lambda (x)
1330: 0a 09 09 20 20 20 28 70 61 72 73 65 2d 6a 73 6f ... (parse-jso
1340: 6e 2d 66 75 6e 63 74 69 6f 6e 20 78 20 28 63 61 n-function x (ca
1350: 72 20 6d 29 29 29 0a 09 09 20 28 63 64 72 20 6d r m)))... (cdr m
1360: 29 29 29 0a 09 20 20 20 20 20 20 27 74 72 75 6e ))).. 'trun
1370: 63 61 74 65 29 29 20 60 28 28 22 63 61 69 72 6f cate)) `(("cairo
1380: 22 20 2e 20 2c 63 61 69 72 6f 2d 6a 73 6f 6e 29 " . ,cairo-json)
1390: 20 28 22 63 61 69 72 6f 2d 70 64 66 22 20 2e 20 ("cairo-pdf" .
13a0: 2c 63 61 69 72 6f 2d 70 64 66 2d 6a 73 6f 6e 29 ,cairo-pdf-json)
13b0: 29 29 0a )).