public
Description: An easy way to make web apps (in PLT Scheme)
Homepage: http://blog.leftparen.com
Clone URL: git://github.com/vegashacker/leftparen.git
Click here to lend your support to: leftparen and make a donation at www.pledgie.com !
leftparen / js.scm
100644 55 lines (45 sloc) 1.663 kb
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
#lang scheme/base
 
(require "util.scm")
 
(provide js-script-invoke
         js-array
         js-hash
         js-quote
         js-call
         js-call-on-load
         )
 
(define (js-script-invoke . js-strs)
  `(script ((language "javascript"))
           ,(string-join js-strs "\n")))
 
(define (js-array scheme-lst)
  (string-append "[" (string-join scheme-lst ", ") "]"))
 
(define (js-hash scheme-hash)
  (string-append
   "{ "
   (string-join (hash-map scheme-hash (lambda (k v) (format "~A:~A" (js-quote k) v)))
                ", ")
   "}"))
  
(define (js-quote thing)
  (cond ((number? thing) (number->string thing))
        ((or (string? thing) (symbol? thing))
         (format "\"~A\"" (careful-string-quote (if (string? thing)
                                                    thing
                                                    (symbol->string thing)))))
        ((eq? thing #t) "true")
        ((eq? thing #f) "false")
        (else (e "Don't know how to js-quote ~A." thing))))
 
(define (careful-string-quote scm-str)
  (pregexp-replace-many scm-str
                        ("\n" => " ")
                        ("\r" => " ")
                        ("\"" => "'")))
 
(define (js-call-on-load fn-name #:quote-all (quote-all #f) . args)
  (format "$(document).ready(function() { ~A })"
          (apply js-call fn-name #:quote-all quote-all args)))
 
;;
;; js-call
;;
;; #:quote-all if #t, then assume all arguments are primitive JS values and js-quote them
;;
(define (js-call fn-name #:quote-all (quote-all #f) . args)
  (let ((args (if quote-all (map js-quote args) args)))
    (string-append fn-name "(" (string-join args ", ") ")")))