From 8dd8dafdecf065e2b195ada8aa737ea1c5f11225 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Wed, 30 Nov 2011 15:19:12 -0500 Subject: [PATCH 1/4] extending the ffi for attribute reading, writing, and raw strings --- js/js-impl.js | 181 ++++++++++++++++++++++++++++++-------------- js/main.rkt | 7 ++ js/racket-impl.rkt | 17 +++++ storage/storage.rkt | 3 + 4 files changed, 151 insertions(+), 57 deletions(-) create mode 100644 storage/storage.rkt diff --git a/js/js-impl.js b/js/js-impl.js index a76ceaf..636d40e 100644 --- a/js/js-impl.js +++ b/js/js-impl.js @@ -1,68 +1,135 @@ -var VOID = plt.baselib.constants.VOID_VALUE; -var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure; +/*jslint devel: true, browser: false, unparam: true, sub: true, windows: false, vars: true, white: true, maxerr: 50, indent: 4 */ -EXPORTS['alert'] = - makePrimitiveProcedure( - 'alert', - 1, - function(MACHINE) { - var elt = MACHINE.e[MACHINE.e.length - 1]; - alert(String(elt)); - return VOID; - }); +/*global $,plt,EXPORTS,document,window*/ +(function() { + "use strict"; + + var VOID = plt.baselib.constants.VOID_VALUE; + var makePrimitiveProcedure = plt.baselib.functions.makePrimitiveProcedure; + var makeCheckArgumentType = plt.baselib.check.makeCheckArgumentType; + var checkSymbolOrString = plt.baselib.check.checkSymbolOrString; + var checkAny = makeCheckArgumentType(function(x) { return true; }, + "any"); + + EXPORTS['alert'] = + makePrimitiveProcedure( + 'alert', + 1, + function(MACHINE) { + var elt = MACHINE.e[MACHINE.e.length - 1]; + alert(String(elt)); + return VOID; + }); -EXPORTS['body'] = $(document.body); + EXPORTS['body'] = $(document.body); -EXPORTS['$'] = - makePrimitiveProcedure( - '$', - 1, - function(MACHINE) { - var obj = MACHINE.e[MACHINE.e.length - 1]; - return $(obj); - }); + EXPORTS['$'] = + makePrimitiveProcedure( + '$', + 1, + function(MACHINE) { + var obj = MACHINE.e[MACHINE.e.length - 1]; + return $(obj); + }); -EXPORTS['call-method'] = - makePrimitiveProcedure( - 'call-method', - plt.baselib.arity.makeArityAtLeast(2), - function(MACHINE) { - var obj = MACHINE.e[MACHINE.e.length - 1]; - var methodName = MACHINE.e[MACHINE.e.length - 2]; - var args = []; - for (var i = 0; i < MACHINE.a - 2; i++) { - args.push(MACHINE.e[MACHINE.e.length -1 - 2 - i]); - } - var result = obj[methodName].apply(obj, args); - return result; - }); + EXPORTS['call-method'] = + makePrimitiveProcedure( + 'call-method', + plt.baselib.arity.makeArityAtLeast(2), + function(MACHINE) { + var obj = MACHINE.e[MACHINE.e.length - 1]; + var methodName = MACHINE.e[MACHINE.e.length - 2]; + var args = [], i; + for (i = 0; i < MACHINE.a - 2; i = i+1) { + args.push(MACHINE.e[MACHINE.e.length -1 - 2 - i]); + } + var result = obj[methodName].apply(obj, args); + return result; + }); + + + EXPORTS['window'] = window; + + + EXPORTS['get-attr'] = + makePrimitiveProcedure( + 'get-attr', + plt.baselib.arity.makeArityAtLeast(2), + function(MACHINE) { + var obj = checkAny(MACHINE, 'get-attr', 0), attr, i; + for (i = 1; i < MACHINE.a; i = i + 1) { + attr = checkSymbolOrString(MACHINE, 'get-attr', i).toString(); + obj = obj[attr]; + } + return obj; + }); + + + EXPORTS['set-attr!'] = + makePrimitiveProcedure( + 'set-attr!', + 3, + function(MACHINE) { + var obj = checkAny(MACHINE, 'set-attr!', 0); + var attr = checkSymbolOrString(MACHINE, 'set-attr!', 1).toString(); + var val = checkAny(MACHINE, 'set-attr!', 2); + obj[attr] = val; + return VOID; + }); + + EXPORTS['js-string?'] = + makePrimitiveProcedure( + 'js-string?', + 1, + function(MACHINE) { + return typeof(checkAny(MACHINE, 'js-string?', 0)) === 'string'; + }); + + EXPORTS['string->js-string'] = + makePrimitiveProcedure( + 'string->js-string', + 1, + function(MACHINE) { + return checkString(MACHINE, 'string->js-string', 0).toString(); + }); + + EXPORTS['js-string->string'] = + makePrimitiveProcedure( + 'js-string->string', + 1, + function(MACHINE) { + return checkJsString(MACHINE, 'string->js-string', 0); + }); -// Javascript-specific extensions. A small experiment. -EXPORTS['viewport-width'] = - makePrimitiveProcedure( - 'viewport-width', - 0, - function(MACHINE) { - return $(window).width(); - }); - -EXPORTS['viewport-height'] = - makePrimitiveProcedure( - 'viewport-height', - 0, - function(MACHINE) { - return $(window).height(); - }); -EXPORTS['in-javascript-context?'] = - makePrimitiveProcedure( - 'in-javascript-context?', - 0, - function(MACHINE) { - return true; - }); + // Javascript-specific extensions. A small experiment. + EXPORTS['viewport-width'] = + makePrimitiveProcedure( + 'viewport-width', + 0, + function(MACHINE) { + return $(window).width(); + }); + + EXPORTS['viewport-height'] = + makePrimitiveProcedure( + 'viewport-height', + 0, + function(MACHINE) { + return $(window).height(); + }); + + + EXPORTS['in-javascript-context?'] = + makePrimitiveProcedure( + 'in-javascript-context?', + 0, + function(MACHINE) { + return true; + }); +}()); \ No newline at end of file diff --git a/js/main.rkt b/js/main.rkt index f07bd97..f4c77e5 100644 --- a/js/main.rkt +++ b/js/main.rkt @@ -8,6 +8,13 @@ call-method $ + get-attr + set-attr! + + js-string? + string->js-string + js-string->string + viewport-width viewport-height in-javascript-context? diff --git a/js/racket-impl.rkt b/js/racket-impl.rkt index 86a26e1..4787435 100644 --- a/js/racket-impl.rkt +++ b/js/racket-impl.rkt @@ -18,6 +18,23 @@ 'not-done-yet) +(define (get-attr object attr . other-attrs) + (error 'get-attr "Not available outside JavaScript context")) + + +(define (set-attr! obj attr value) + (error 'set-attr! "Not available outside JavaScript context")) + + + +(define (js-string? x) + (error 'js-string? "Not available outside JavaScript context")) +(define (string->js-string x) + (error 'string->js-string "Not available outside JavaScript context")) +(define (js-string->string x) + (error 'js-string->string "Not available outside JavaScript context")) + + ;; in-javascript-context: -> boolean diff --git a/storage/storage.rkt b/storage/storage.rkt new file mode 100644 index 0000000..5c9f73e --- /dev/null +++ b/storage/storage.rkt @@ -0,0 +1,3 @@ +#lang s-exp "../lang/base.rkt" + +(require "../js.rkt") \ No newline at end of file From 11b2c0f41fd04c6443fc773aa26e69fbdd7ca83a Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Wed, 30 Nov 2011 15:39:43 -0500 Subject: [PATCH 2/4] continuing to implement the storage object --- js/js-impl.js | 36 ++++++++++++++++++++++++++++++++++++ js/main.rkt | 8 +++++++- js/racket-impl.rkt | 23 ++++++++++++++++++++++- storage/storage.rkt | 38 +++++++++++++++++++++++++++++++++++++- 4 files changed, 102 insertions(+), 3 deletions(-) diff --git a/js/js-impl.js b/js/js-impl.js index 636d40e..a392a5a 100644 --- a/js/js-impl.js +++ b/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. diff --git a/js/main.rkt b/js/main.rkt index f4c77e5..9ee0f1e 100644 --- a/js/main.rkt +++ b/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 diff --git a/js/racket-impl.rkt b/js/racket-impl.rkt index 4787435..5629b60 100644 --- a/js/racket-impl.rkt +++ b/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")) + + diff --git a/storage/storage.rkt b/storage/storage.rkt index 5c9f73e..a835b3b 100644 --- a/storage/storage.rkt +++ b/storage/storage.rkt @@ -1,3 +1,39 @@ #lang s-exp "../lang/base.rkt" -(require "../js.rkt") \ No newline at end of file +;; 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"))) \ No newline at end of file From f4185b3c61ca42150d7af3938f062d378d5bf87f Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Wed, 30 Nov 2011 16:03:39 -0500 Subject: [PATCH 3/4] playing around with storage --- Makefile | 4 +- js/js-impl.js | 11 ++++- js/main.rkt | 3 ++ js/racket-impl.rkt | 10 ++++ sandbox/test-storage.rkt | 11 +++++ sandbox/todo-storage/index.html | 14 ++++++ sandbox/todo-storage/todo.rkt | 87 +++++++++++++++++++++++++++++++++ storage.rkt | 3 ++ storage/storage.rkt | 6 ++- version.rkt | 2 +- 10 files changed, 145 insertions(+), 6 deletions(-) create mode 100644 sandbox/test-storage.rkt create mode 100644 sandbox/todo-storage/index.html create mode 100644 sandbox/todo-storage/todo.rkt create mode 100644 storage.rkt diff --git a/Makefile b/Makefile index c0a607a..50be87c 100644 --- a/Makefile +++ b/Makefile @@ -44,8 +44,8 @@ cs019-doc: setup: - raco setup --no-docs -P dyoo whalesong.plt 1 8 + raco setup --no-docs -P dyoo whalesong.plt 1 10 planet-link: - raco planet link dyoo whalesong.plt 1 8 . + raco planet link dyoo whalesong.plt 1 10 . diff --git a/js/js-impl.js b/js/js-impl.js index a392a5a..83430f7 100644 --- a/js/js-impl.js +++ b/js/js-impl.js @@ -139,7 +139,16 @@ return plt.baselib.numbers.toFixnum(checkNumber(MACHINE, 'js-string?', 0)); }); - + + EXPORTS['js-null?'] = + makePrimitiveProcedure( + 'js-null?', + 1, + function(MACHINE) { + return checkAny(MACHINE, 'js-null?', 0) === null; + }); + + EXPORTS['js-null'] = null; diff --git a/js/main.rkt b/js/main.rkt index 9ee0f1e..b731f61 100644 --- a/js/main.rkt +++ b/js/main.rkt @@ -24,4 +24,7 @@ viewport-width viewport-height in-javascript-context? + + js-null? + js-null )) \ No newline at end of file diff --git a/js/racket-impl.rkt b/js/racket-impl.rkt index 5629b60..0272f29 100644 --- a/js/racket-impl.rkt +++ b/js/racket-impl.rkt @@ -14,6 +14,9 @@ js-number? number->js-number js-number->number + + js-null? + js-null ) (define (alert x) @@ -56,6 +59,13 @@ +(define (js-null? x) + (error 'js-null? "Not available outside JavaScript context")) + +(define js-null 'not-done-yet) + + + ;; in-javascript-context: -> boolean diff --git a/sandbox/test-storage.rkt b/sandbox/test-storage.rkt new file mode 100644 index 0000000..25f14eb --- /dev/null +++ b/sandbox/test-storage.rkt @@ -0,0 +1,11 @@ +#lang planet dyoo/whalesong + +(require (planet dyoo/whalesong/storage)) + +(storage-length) +(storage-ref "whalesong test") +(storage-set! "whalesong test" "hello world") +(storage-ref "whalesong test") +(storage-length) +(storage-clear!) +(storage-length) \ No newline at end of file diff --git a/sandbox/todo-storage/index.html b/sandbox/todo-storage/index.html new file mode 100644 index 0000000..7c6b5f7 --- /dev/null +++ b/sandbox/todo-storage/index.html @@ -0,0 +1,14 @@ + +TODO List + +

TODO

+ +

Items

+
    + + +

    Adding an item

    + + + + diff --git a/sandbox/todo-storage/todo.rkt b/sandbox/todo-storage/todo.rkt new file mode 100644 index 0000000..3dd5554 --- /dev/null +++ b/sandbox/todo-storage/todo.rkt @@ -0,0 +1,87 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/web-world) + (planet dyoo/whalesong/resource) + (planet dyoo/whalesong/storage)) + +;; The world is our TODO list, represented as a list of strings. + +(define-resource index.html) + + +;; An item consists of a string id, the item's content, and a finished? flag. +(define-struct item (id ;; string + content ;; string + finished? ;; boolean + )) + + +;; new-item: string -> item +(define (new-item content) + (make-item (fresh-id) content #f)) + + +;; toggle-item-finished: world string -> world +;; Mark the item with the given id so that it's finished, or reverse that change. +(define (toggle-item-finished world id) + (cond + [(empty? world) + '()] + [(string=? id (item-id (first world))) + (cons (make-item id (item-content (first world)) (not (item-finished? (first world)))) + (rest world))] + [else + (cons (first world) + (toggle-item-finished (rest world) id))])) + + + +;; world view -> world +(define (on-add world view) + (local [(define text (view-form-value (view-focus view "next-item")))] + (cons (new-item text) world))) + + +;; world view -> view +(define (draw world view) + (foldl refresh-item-in-view + view + world)) + + + +;; refresh-item-in-view: item view -> view +(define (refresh-item-in-view item view) + (cond + [(view-focus? view (item-id item)) + (update-view-css (view-focus view (item-id item)) + "text-decoration" + (cond [(item-finished? item) + "line-through"] + [else + "none"]))] + [else + (view-bind + (view-append-child (view-focus view "items") + (xexp->dom `(li (@ (id ,(item-id item))) + ,(item-content item)))) + "click" + when-item-clicked)])) + + + +;; when-item-clicked: world view -> world +;; When an item is clicked, set its finished? flag. +(define (when-item-clicked world view) + (toggle-item-finished world (view-attr view "id"))) + + +(define the-view + (view-bind (view-focus (->view index.html) "add-button") + "click" + on-add)) + + +(big-bang (list (new-item "milk") + (new-item "eggs")) + (initial-view the-view) + (to-draw draw)) \ No newline at end of file diff --git a/storage.rkt b/storage.rkt new file mode 100644 index 0000000..f00cbf1 --- /dev/null +++ b/storage.rkt @@ -0,0 +1,3 @@ +#lang s-exp "lang/base.rkt" +(require "storage/storage.rkt") +(provide (all-from-out "storage/storage.rkt")) \ No newline at end of file diff --git a/storage/storage.rkt b/storage/storage.rkt index a835b3b..c273a1e 100644 --- a/storage/storage.rkt +++ b/storage/storage.rkt @@ -23,8 +23,10 @@ (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 val (call-method localStorage "getItem" (string->js-string name))) + (if (js-null? val) + #f + (js-string->string val))) (define (storage-set! name value) (void (call-method localStorage "setItem" diff --git a/version.rkt b/version.rkt index b22d90f..b279385 100644 --- a/version.rkt +++ b/version.rkt @@ -7,4 +7,4 @@ (provide version) (: version String) -(define version "1.90") +(define version "1.94") From d520c1e52d70832612eafe087323f27d4557a781 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Wed, 30 Nov 2011 16:12:50 -0500 Subject: [PATCH 4/4] slightly more exercising of the API --- sandbox/test-storage.rkt | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/sandbox/test-storage.rkt b/sandbox/test-storage.rkt index 25f14eb..d94d033 100644 --- a/sandbox/test-storage.rkt +++ b/sandbox/test-storage.rkt @@ -7,5 +7,21 @@ (storage-set! "whalesong test" "hello world") (storage-ref "whalesong test") (storage-length) +(storage-key 0) (storage-clear!) -(storage-length) \ No newline at end of file +(storage-length) + + +(storage-clear!) +(storage-set! "name" "Danny") +(storage-set! "advisor" "sk") +(storage-set! "advisor" "kathi") +(storage-length) +(storage-key 0) +(storage-key 1) +(storage-remove! "advisor") +(storage-length) +(storage-key 0) +(storage-remove! "name") +(storage-length) +(storage-clear!) \ No newline at end of file