diff options
Diffstat (limited to 'chapter-7/propagators.scm')
| -rw-r--r-- | chapter-7/propagators.scm | 115 |
1 files changed, 54 insertions, 61 deletions
diff --git a/chapter-7/propagators.scm b/chapter-7/propagators.scm index db27a2e..e0096b6 100644 --- a/chapter-7/propagators.scm +++ b/chapter-7/propagators.scm @@ -4,49 +4,34 @@ ((hoot hashtables) #:select (make-weak-key-hashtable weak-key-hashtable-ref weak-key-hashtable-set!)) + ((hoot lists) #:select (fold)) ((hoot numbers) #:select (truncate)) (hoot ffi)) -(define-foreign make-element - "document" "makeElement" - (ref string) -> (ref extern)) +(define-foreign timeout + "window" "setTimeout" + (ref extern) f64 -> i32) + +(define-foreign document-body + "document" "body" + -> (ref null extern)) (define-foreign make-text-node "document" "makeTextNode" (ref string) -> (ref extern)) -(define-foreign get-element-by-id - "document" "getElementById" - (ref string) -> (ref null extern)) - -(define-foreign first-child - "element" "firstChild" - (ref extern) -> (ref null extern)) - -(define-foreign next-sibling - "element" "nextSibling" - (ref extern) -> (ref null extern)) +(define-foreign make-element + "document" "makeElement" + (ref string) -> (ref extern)) (define-foreign append-child! "element" "appendChild" (ref extern) (ref extern) -> (ref extern)) -(define-foreign attribute-ref - "element" "getAttribute" - (ref extern) (ref string) -> (ref string)) - -(define-foreign set-attribute! +(define-foreign attribute-set! "element" "setAttribute" (ref extern) (ref string) (ref string) -> none) -(define-foreign property-ref - "element" "getProperty" - (ref extern) (ref string) -> (ref string)) - -(define-foreign set-property! - "element" "setProperty" - (ref extern) (ref string) (ref string) -> none) - (define-foreign value "element" "getValue" (ref extern) -> (ref string)) @@ -59,22 +44,10 @@ "element" "addEventListener" (ref extern) (ref string) (ref extern) -> none) -(define-foreign remove! - "element" "remove" - (ref extern) -> none) - (define-foreign replace-with! "element" "replaceWith" (ref extern) (ref extern) -> none) -(define-foreign document-body - "document" "getBody" - -> (ref null extern)) - -(define-foreign timeout - "window" "setTimeout" - (ref extern) f64 -> i32) - (define (lset-adjoin = list . rest) (define pred (if (or (eq? = eq?) (eq? = eqv?)) @@ -325,21 +298,41 @@ (lp rest))))))))) (define (merge-ephemeral-timestamps ephemerals) - (let lp ((ephemerals ephemerals) (timestamps '())) - (match ephemerals - (() timestamps) - ((($ <ephemeral> _ timestamps*) . rest) - (let lp2 ((timestamps* timestamps*) (timestamps timestamps)) - (match timestamps* - (() (lp rest timestamps)) - (((and timestamp (key . time)) . rest) - (match (assq-ref timestamps key) - (#f (lp2 rest (cons timestamp timestamps))) - (time* - (if (= time time*) - (lp2 rest timestamps) - #f))))))) - ((_ . rest) (lp rest timestamps))))) + (define (adjoin-keys alist keys) + (fold (lambda (key+value keys) + (match key+value + ((key . _) + (lset-adjoin eq? keys key)))) + keys alist)) + (define (check-timestamps id) + (let lp ((ephemerals ephemerals) (t #f)) + (match ephemerals + (() t) + ((($ <ephemeral> _ timestamps) . rest) + (match (assq-ref timestamps id) + ;; No timestamp for this id in this ephemeral. Continue. + (#f (lp rest t)) + (t* + (if t + ;; If timestamps don't match then we have a mix of + ;; fresh and stale values, so return #f. Otherwise, + ;; continue. + (and (= t t*) (lp rest t)) + ;; Initialize timestamp and continue. + (lp rest t*)))))))) + ;; Build a set of all reactive identifiers across all ephemerals. + (let ((ids (fold (lambda (ephemeral ids) + (adjoin-keys (ephemeral-timestamps ephemeral) ids)) + '() ephemerals))) + (let lp ((ids ids) (timestamps '())) + (match ids + (() timestamps) + ((id . rest) + ;; Check for consistent timestamps. If they are consistent + ;; then add it to the alist and continue. Otherwise, return + ;; #f. + (let ((t (check-timestamps id))) + (and t (lp rest (cons (cons id t) timestamps))))))))) (define (merge-ephemerals old new) (cond @@ -360,15 +353,15 @@ (define-syntax-rule (define-primitive-reactive-propagator name proc) (define name (primitive-reactive-propagator 'name proc))) -(define (r:property input elem property) - (let ((property (symbol->string property))) +(define (r:attribute input elem attr) + (let ((attr (symbol->string attr))) (define (activate) (match (cell-strongest input) (($ <ephemeral> val) - (set-property! elem property (obj->string val))) + (attribute-set! elem attr (obj->string val))) ;; Ignore unusable values. (_ (values)))) - (make-propagator 'property (list input) '() activate))) + (make-propagator 'r:attribute (list input) '() activate))) (define-record-type <binding> (make-binding id cell default group) @@ -454,15 +447,15 @@ (for-each (lambda (attr) (match attr (((? symbol? name) (? string? val)) - (set-attribute! elem + (attribute-set! elem (symbol->string name) val)) (((? symbol? name) (? number? val)) - (set-attribute! elem + (attribute-set! elem (symbol->string name) (number->string val))) (((? symbol? name) (? cell? cell)) - (r:property cell elem name)) + (r:attribute cell elem name)) ;; The value attribute is special and can be ;; used to setup a 2-way data binding. (('value (? binding? binding)) |