continuing to implement the storage object

js/js-impl.js

@@ -8,9 +8,20 @@
     var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure;
     var makeCheckArgumentType = plt.baselib.check.makeCheckArgumentType;
     var checkSymbolOrString = plt.baselib.check.checkSymbolOrString;
+    var checkString = plt.baselib.check.checkString;
     var checkAny = makeCheckArgumentType(function(x) { return true; },
                                          "any");
 
+    var isJsString = function(x) { return typeof(x) === 'string'; };
+    var checkJsString = makeCheckArgumentType(isJsString, 'JavaScript string');
+
+
+
+    var isJsNumber = function(x) { return typeof(x) === 'number'; };
+    var checkNumber = plt.baselib.check.checkNumber;
+    var checkJsNumber = makeCheckArgumentType(isJsNumber, 'JavaScript number');
+
+
     EXPORTS['alert'] =
         makePrimitiveProcedure(
             'alert',
@@ -105,6 +116,31 @@
 
 
 
+    EXPORTS['js-number?'] = 
+        makePrimitiveProcedure(
+            'js-number?',
+            1,
+            function(MACHINE) {
+                return isJsNumber(checkAny(MACHINE, 'js-string?', 0));
+            });    
+    EXPORTS['js-number->number'] = 
+        makePrimitiveProcedure(
+            'js-number->number',
+            1,
+            function(MACHINE) {
+                return plt.baselib.numbers.makeFloat(checkJsNumber(MACHINE, 'js-string?', 0));
+            });    
+
+    EXPORTS['number->js-number'] = 
+        makePrimitiveProcedure(
+            'number->js-number',
+            1,
+            function(MACHINE) {
+                return plt.baselib.numbers.toFixnum(checkNumber(MACHINE, 'js-string?', 0));
+            });    
+
+    
+
 
 
     // Javascript-specific extensions.  A small experiment.

js/main.rkt

@@ -7,13 +7,19 @@
                     body
                     call-method
                     $
-
+                    
+                    window
+                    
                     get-attr
                     set-attr!
 
                     js-string?
                     string->js-string
                     js-string->string
+
+                    js-number?
+                    number->js-number
+                    js-number->number
                     
                     viewport-width
                     viewport-height

js/racket-impl.rkt

@@ -3,7 +3,18 @@
 (provide alert body call-method $
          in-javascript-context?
          viewport-width
-         viewport-height)
+         viewport-height
+
+         window
+         get-attr
+         set-attr!
+         js-string?
+         string->js-string
+         js-string->string
+         js-number?
+         number->js-number
+         js-number->number
+         )
 
 (define (alert x)
   (display x)
@@ -17,6 +28,8 @@
 (define ($ name)
   'not-done-yet)
 
+(define window 'not-available-outside-JavaScript-context)
+
 
 (define (get-attr object attr . other-attrs)
   (error 'get-attr "Not available outside JavaScript context"))
@@ -34,6 +47,14 @@
 (define (js-string->string x)
   (error 'js-string->string "Not available outside JavaScript context"))
 
+(define (js-number? x)
+  (error 'js-number? "Not available outside JavaScript context"))
+(define (number->js-number x)
+  (error 'number->js-number "Not available outside JavaScript context"))
+(define (js-number->number x)
+  (error 'js-number->number "Not available outside JavaScript context"))
+
+
 
 
 

storage/storage.rkt

@@ -1,3 +1,39 @@
 #lang s-exp "../lang/base.rkt"
 
-(require "../js.rkt")
+;; Bindings to HTML5 storage
+;; http://dev.w3.org/html5/webstorage/
+
+
+(require "../js.rkt")
+
+(provide storage-length
+         storage-key
+         storage-ref
+         storage-set!
+         storage-remove!
+         storage-clear!)
+
+
+(define localStorage (get-attr window "localStorage"))
+
+(define (storage-length)
+  (inexact->exact (js-number->number (get-attr localStorage "length"))))
+
+(define (storage-key i)
+  (js-string->string (call-method localStorage "key" (number->js-number i))))
+
+(define (storage-ref name)
+  (js-string->string
+   (call-method localStorage "getItem" (string->js-string name))))
+
+(define (storage-set! name value)
+  (void (call-method localStorage "setItem"
+                     (string->js-string name)
+                     (string->js-string value))))
+
+(define (storage-remove! name)
+  (void (call-method localStorage "removeItem"
+                     (string->js-string name))))
+
+(define (storage-clear!)
+  (void (call-method localStorage "clear")))