diff --git a/Makefile b/Makefile
index 50be87c..c4da3d9 100644
--- a/Makefile
+++ b/Makefile
@@ -44,6 +44,7 @@ cs019-doc:
setup:
+
raco setup --no-docs -P dyoo whalesong.plt 1 10
diff --git a/examples/hello-css.css b/examples/hello-css.css
new file mode 100644
index 0000000..1ef59eb
--- /dev/null
+++ b/examples/hello-css.css
@@ -0,0 +1,3 @@
+body {
+ background-color: blue
+}
diff --git a/examples/hello-css.rkt b/examples/hello-css.rkt
new file mode 100644
index 0000000..46528f6
--- /dev/null
+++ b/examples/hello-css.rkt
@@ -0,0 +1,12 @@
+#lang planet dyoo/whalesong/base
+(require (planet dyoo/whalesong/web-world)
+ (planet dyoo/whalesong/resource))
+
+(define-resource hello-css.css)
+(define-resource hello-css-main.html)
+
+(big-bang 0
+ (initial-view hello-css-main.html)
+ (to-draw (lambda (w v) v)))
+
+"done"
\ No newline at end of file
diff --git a/info.rkt b/info.rkt
index 9f0db04..634028e 100644
--- a/info.rkt
+++ b/info.rkt
@@ -2,8 +2,8 @@
(define name "Whalesong")
(define blurb '("A Racket to JavaScript compiler"))
-(define release-notes '((p "Bug fix to allow --compress-javascript to work again. Some improved error trapping on the view-navigation methods. Bug fix on appcache manifest to allow network communication. Replaced 'not a closure' messages with the application error instead.")))
-(define version "1.8")
+(define release-notes '((p "Added view-has-attr? and remove-view-attr. Added example with checkboxes. Improved compatibility with web-world and the Android web browser: external css style sheets should now work. Miscellaneous bug fixes.")))
+(define version "1.9")
(define categories '(devtools))
(define repositories '("4.x"))
(define required-core-version "5.1.1")
diff --git a/js-assembler/assemble-perform-statement.rkt b/js-assembler/assemble-perform-statement.rkt
index 0b754e9..952b4f3 100644
--- a/js-assembler/assemble-perform-statement.rkt
+++ b/js-assembler/assemble-perform-statement.rkt
@@ -15,7 +15,7 @@
(cond
[(CheckToplevelBound!? op)
- (format "if (M.e[M.e.length-~a][~a]===undefined){ RT.raiseUnboundToplevelError(M.e[M.e.length-~a].names[~a]); }"
+ (format "if (M.e[M.e.length-~a][~a]===undefined){ RT.raiseUnboundToplevelError(M,M.e[M.e.length-~a].names[~a]); }"
(add1 (CheckToplevelBound!-depth op))
(CheckToplevelBound!-pos op)
(add1 (CheckToplevelBound!-depth op))
diff --git a/make-planet-archive.sh b/make-planet-archive.sh
index 9796fb5..7d7e5d1 100755
--- a/make-planet-archive.sh
+++ b/make-planet-archive.sh
@@ -1,6 +1,6 @@
#!/bin/bash
MAJOR=1
-MINOR=8
+MINOR=9
PROJNAME=whalesong
diff --git a/scribblings/cs019.scrbl b/scribblings/cs019.scrbl
index 4533cfd..597d815 100644
--- a/scribblings/cs019.scrbl
+++ b/scribblings/cs019.scrbl
@@ -66,7 +66,7 @@ Run the following to create the @filepath{whalesong} launcher program in
your current directory.
@codeblock|{
#lang racket/base
-(require (planet dyoo/whalesong:1:8/make-launcher))
+(require (planet dyoo/whalesong:1:9/make-launcher))
}|
This may take a few minutes, as Racket is compiling Whalesong, its
dependencies, and its documentation. When it finally finishes,
@@ -417,6 +417,14 @@ A simple TODO list manager.
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
}
+
+
+@item{@link["http://hashcollision.org/whalesong/examples/hot-cross-buns/hot-cross-buns.html"]{hot-cross-buns.html}
+[@link["http://hashcollision.org/whalesong/examples/hot-cross-buns/hot-cross-buns.rkt"]{src}]
+Demonstrates use of checkboxes. Uses @racket[view-has-attr?] to see if a checkbox has been
+checked, and @racket[remove-view-attr] to change the @emph{checked} attribute when the user
+wants to reset the page.
+}
]
These examples are written in a less featureful language level
@@ -671,10 +679,17 @@ in the tree, but not be shown.
Get the attribute @racket[name] at the focus.
}
+@defproc[(view-has-attr? [v view] [name String]) boolean]{
+Returns true if the element at the focus has an attribute @racket[name].
+}
+
@defproc[(update-view-attr [v view] [name String] [value String]) view]{
Update the attribute @racket[name] with the value @racket[value] at the focus.
}
+@defproc[(remove-view-attr [v view] [name String]) view]{
+Remove the attribute @racket[name] at the focus.
+}
@defproc[(view-css [v view] [name String]) view]{
Get the css value @racket[name] at the focus.
diff --git a/scribblings/manual.scrbl b/scribblings/manual.scrbl
index ef3ba5a..ad0e8be 100644
--- a/scribblings/manual.scrbl
+++ b/scribblings/manual.scrbl
@@ -162,6 +162,14 @@ A simple TODO list manager.
[@link["http://hashcollision.org/whalesong/examples/where-am-i/where-am-i.rkt"]{src}]
Uses @racket[on-location-change] and @racket[on-mock-location-change] to demonstrate location services.
}
+
+
+@item{@link["http://hashcollision.org/whalesong/examples/hot-cross-buns/hot-cross-buns.html"]{hot-cross-buns.html}
+[@link["http://hashcollision.org/whalesong/examples/hot-cross-buns/hot-cross-buns.rkt"]{src}]
+Demonstrates use of checkboxes. Uses @racket[view-has-attr?] to see if a checkbox has been
+checked, and @racket[remove-view-attr] to change the @emph{checked} attribute when the user
+wants to reset the page.
+}
]
@@ -195,7 +203,7 @@ If you want to use Whalesong, run the following to create
the @filepath{whalesong} launcher:
@codeblock|{
#lang racket/base
-(require (planet dyoo/whalesong:1:8/make-launcher))
+(require (planet dyoo/whalesong:1:9/make-launcher))
}|
This may take a few minutes, as Racket is compiling Whalesong, its
dependencies, and its documentation. When it finally finishes,
@@ -884,10 +892,18 @@ Hide the element at the focus.
Get the attribute @racket[name] at the focus.
}
+@defproc[(view-has-attr? [v view] [name String]) boolean]{
+Returns true if the element at the focus has an attribute @racket[name].
+}
+
@defproc[(update-view-attr [v view] [name String] [value String]) view]{
Update the attribute @racket[name] with the value @racket[value] at the focus.
}
+@defproc[(remove-view-attr [v view] [name String]) view]{
+Remove the attribute @racket[name] at the focus.
+}
+
@defproc[(view-css [v view] [name String]) view]{
Get the css value @racket[name] at the focus.
}
diff --git a/web-world/examples/hot-cross-buns/hot-cross-buns.rkt b/web-world/examples/hot-cross-buns/hot-cross-buns.rkt
new file mode 100644
index 0000000..d232623
--- /dev/null
+++ b/web-world/examples/hot-cross-buns/hot-cross-buns.rkt
@@ -0,0 +1,61 @@
+#lang planet dyoo/whalesong/cs019
+
+(define-resource index.html)
+
+(define base-view (->view index.html))
+
+(define WORDS (list "hot" "cross" "buns"))
+
+
+(define (remove-all x elts)
+ (cond
+ [(empty? elts)
+ empty]
+ [(equal? x (first elts))
+ (remove-all x (rest elts))]
+ [else
+ (cons (first elts)
+ (remove-all x (rest elts)))]))
+
+(define view-with-buttons
+ (foldl (lambda (name a-view)
+ (view-bind (view-focus a-view name)
+ "click"
+ (lambda (world a-view)
+ (cond
+ [(view-has-attr? a-view "checked")
+ (cons name world)]
+ [else
+ (remove-all name world)]))))
+ base-view
+ WORDS))
+
+(define view-with-buttons-and-reset
+ (view-bind (view-focus view-with-buttons "reset")
+ "click"
+ (lambda (world a-view)
+ empty)))
+
+
+(define (draw world v)
+ (local ([define view-with-updated-message
+ (update-view-text (view-focus v "mydiv")
+ (format "~s" world))])
+ (foldl (lambda (word a-view)
+ (local [(define view-on-word
+ (view-focus a-view word))]
+ (cond
+ [(and (view-has-attr? view-on-word "checked")
+ (not (member word world)))
+ (remove-view-attr view-on-word "checked")]
+ [(and (not (view-has-attr? view-on-word "checked"))
+ (member word world))
+ (update-view-attr view-on-word "checked" "checked")]
+ [else
+ a-view])))
+ view-with-updated-message
+ WORDS)))
+
+(big-bang '()
+ (initial-view view-with-buttons-and-reset)
+ (to-draw draw))
\ No newline at end of file
diff --git a/web-world/examples/hot-cross-buns/index.html b/web-world/examples/hot-cross-buns/index.html
new file mode 100644
index 0000000..0a387d3
--- /dev/null
+++ b/web-world/examples/hot-cross-buns/index.html
@@ -0,0 +1,9 @@
+
+Hot Cross Buns
+
+Hot
+Cross
+Buns
+
+
+
diff --git a/web-world/impl.rkt b/web-world/impl.rkt
index 2748e5c..7075ea2 100644
--- a/web-world/impl.rkt
+++ b/web-world/impl.rkt
@@ -65,7 +65,9 @@
view-hide
view-attr
+ view-has-attr?
update-view-attr
+ remove-view-attr
view-css
update-view-css
diff --git a/web-world/js-impl.js b/web-world/js-impl.js
index a721c48..69ce92c 100644
--- a/web-world/js-impl.js
+++ b/web-world/js-impl.js
@@ -44,6 +44,14 @@
var shallowCloneNode = function(node) {
var result = node.cloneNode(false);
+ var i;
+ // copy over the attributes as well
+ if (node.attributes) {
+ for (i = 0; i < node.attributes.length; i++) {
+ $(result).attr(node.attributes[i].name,
+ node.attributes[i].value);
+ }
+ }
$(result).data($(node).data());
return result;
};
@@ -204,7 +212,11 @@
};
MockView.prototype.getAttr = function(name) {
- return this.cursor.node[0].getAttribute(name);
+ return $(this.cursor.node[0]).attr(name);
+ };
+
+ MockView.prototype.hasAttr = function(name) {
+ return $(this.cursor.node[0]).attr(name) !== undefined;
};
@@ -223,6 +235,22 @@
});
};
+ MockView.prototype.removeAttr = function(name) {
+ return this.act(
+ function(cursor) {
+ return cursor.replaceNode([$(shallowCloneNode(cursor.node[0]))
+ .removeAttr(name).get(0)]
+ .concat(cursor.node.slice(1)));
+ },
+ function(eventHandlers) {
+ return eventHandlers;
+ },
+ function(view) {
+ $(view.focus).removeAttr(name);
+ });
+ };
+
+
@@ -569,16 +597,16 @@
var defaultToRender = function(){};
View.prototype.initialRender = function(top) {
- $(top).empty();
- // Special case: if this.top is an html, we merge into the
- // existing page.
- if ($(this.top).children("title").length !== 0) {
- $(document.head).find('title').remove();
- }
- $(document.head).append($(this.top).children("title"));
- $(document.head).append($(this.top).children("link"));
-
- $(top).append(this.top);
+ $(top).empty();
+ // Special case: if this.top is an html, we merge into the
+ // existing page.
+ if ($(this.top).children("title").length !== 0) {
+ $(document.head).find('title').remove();
+ }
+ $(document.head).append($(this.top).children("title").clone(true));
+ $(document.head).append($(this.top).children("link").clone(true));
+
+ $(top).append($(this.top));
// The snip here is meant to accomodate weirdness with canvas dom
// elements. cloning a canvas doesn't preserve how it draws.
@@ -628,11 +656,24 @@
+ var rscript = /)<[^<]*)*<\/script>/gi;
+ // We have to do some kludgery to support the android browser,
+ // which does not properly parse .
+ var rlink = /]* \/>(.*?)/gi;
var parseStringAsHtml = function(str) {
- var dom = $('').append($(str));
- return dom;
+ var div = document.createElement("div");
+ // inject the contents of the document in, removing the scripts
+ // to avoid any 'Permission Denied' errors in IE
+ div.innerHTML = str.replace(rscript, "").replace(rlink, "");
+ var linkMatches = str.match(rlink);
+ if (linkMatches) {
+ for (var i = 0; i < linkMatches.length; i++) {
+ $(div).append($(linkMatches[i]));
+ }
+ }
+ return $(div);
};
@@ -1885,6 +1926,14 @@
return view.getAttr(name);
});
+ EXPORTS['view-has-attr?'] = makePrimitiveProcedure(
+ 'view-has-attr?',
+ 2,
+ function(MACHINE) {
+ var view = checkMockViewOnElement(MACHINE, 'view-has-attr?', 0);
+ var name = checkSymbolOrString(MACHINE, 'view-has-attr?', 1).toString();
+ return view.hasAttr(name);
+ });
EXPORTS['update-view-attr'] = makePrimitiveProcedure(
'update-view-attr',
@@ -1896,6 +1945,14 @@
return view.updateAttr(name, value);
});
+ EXPORTS['remove-view-attr'] = makePrimitiveProcedure(
+ 'remove-view-attr',
+ 2,
+ function(MACHINE) {
+ var view = checkMockViewOnElement(MACHINE, 'remove-view-attr', 0);
+ var name = checkSymbolOrString(MACHINE, 'remove-view-attr', 1).toString();
+ return view.removeAttr(name);
+ });
EXPORTS['view-css'] = makePrimitiveProcedure(
'view-css',
diff --git a/web-world/racket-impl.rkt b/web-world/racket-impl.rkt
index 1b097c4..669742d 100644
--- a/web-world/racket-impl.rkt
+++ b/web-world/racket-impl.rkt
@@ -18,7 +18,7 @@
view-backward
view-text update-view-text
- view-attr update-view-attr
+ view-attr view-has-attr? update-view-attr remove-view-attr
view-css update-view-css
view-id
@@ -148,9 +148,15 @@
(define (view-attr v attr-name)
(error 'view-attr "Please run in JavaScript context."))
+(define (view-has-attr? v attr-name)
+ (error 'view-has-attr? "Please run in JavaScript context."))
+
(define (update-view-attr v attr-name value)
(error 'update-view-attr "Please run in JavaScript context."))
+(define (remove-view-attr v attr-name)
+ (error 'remove-view-attr "Please run in JavaScript context."))
+