Merge commit 'origin/master'

Conflicts:

	Makefile

Makefile

@@ -44,6 +44,7 @@ cs019-doc:
 
 
 setup:
+
 	raco setup --no-docs -P dyoo whalesong.plt 1 10
 
 

examples/hello-css.css

@@ -0,0 +1,3 @@
+body {
+    background-color: blue
+}

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"

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 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.8")
+(define version "1.9")
 (define categories '(devtools))
 (define repositories '("4.x"))
 (define required-core-version "5.1.1")

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))

make-planet-archive.sh

@@ -1,6 +1,6 @@
 #!/bin/bash
 MAJOR=1
-MINOR=8
+MINOR=9
 PROJNAME=whalesong
 
 

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.

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.
 }

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))

web-world/examples/hot-cross-buns/index.html

@@ -0,0 +1,9 @@
+<html>
+<head><title>Hot Cross Buns</title></head>
+
+<input id="hot" type="checkbox" value="Hot"/>Hot
+<input id="cross" type="checkbox" value="Cross"/>Cross
+<input id="buns" type="checkbox" value="Buns"/>Buns
+<input id="reset" type="button" value="Reset"/>
+<div id="mydiv"/>
+</html>

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

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();
+       $(top).empty();
-        // Special case: if this.top is an html, we merge into the
+       // Special case: if this.top is an html, we merge into the
-        // existing page.
+       // existing page.
-        if ($(this.top).children("title").length !== 0) {
+       if ($(this.top).children("title").length !== 0) {
-             $(document.head).find('title').remove();
+           $(document.head).find('title').remove();
-        }
+       }
-        $(document.head).append($(this.top).children("title"));
+       $(document.head).append($(this.top).children("title").clone(true));
-        $(document.head).append($(this.top).children("link"));
+       $(document.head).append($(this.top).children("link").clone(true));
        
-        $(top).append(this.top);
+       $(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\b[^<]*(?:(?!<\/script>)<[^<]*)*<\/script>/gi;
 
+    // We have to do some kludgery to support the android browser,
+    // which does not properly parse <link ...>.
+    var rlink = /<link\b[^\/>]* \/>(.*?)/gi;
 
     var parseStringAsHtml = function(str) {
-        var dom = $('<div/>').append($(str));
+        var div = document.createElement("div");
-        return dom;
+        // 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',

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."))
+