Clean up btn.

3 files changed, 22 insertions, 25 deletions

diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm
index 33268721..df30b6bc 100644
--- a/module/calp/html/components.scm
+++ b/module/calp/html/components.scm
@@ -41,36 +41,35 @@
         ,(format #f "document.documentElement.style.setProperty('--~a', this.value + '~a')"
                  variable unit)))))
 
+
+;; Takes a (flat list which may contains keywords followed by items.
+;; Return a new list where each of the keyword-value pairs have been removed.
+(define (remove-key-values list)
+  (cond ((null? list) '())
+        ((keyword? (car list)) (remove-key-values (cddr list)))
+        (else (cons (car list) (remove-key-values (cdr list))))))
+
 ;; Generates a button or button-like link.
 (define* (btn key: onclick href (class '())
-              allow-other-keys:
               rest: args)
   (when (and onclick href)
     (scm-error 'wrong-type-arg "btn"
                (_ "href and onclick are mutually exclusive. href = ~s, onclick = ~s.")
                (list href onclick)
                #f))
-
-  (let ((body #f))
-    `(,(cond [href 'a]
-             [else 'button])
-      (@ (class ,(string-join (cons "btn" class) " "))
-         ,@(cond [onclick `((onclick ,onclick))]
-                 [href `((href ,href))]
-                 [else '()])
-         ,@(let loop ((rem args))
-             (cond
-              [(null? rem) '()]
-              [(memv (car rem) '(onclick: href: class:))
-               (loop (cddr rem))]
-              [(keyword? (car rem))
-               (cons* `(,(keyword->symbol (car rem))
-                        ,(cadr rem))
-                      (loop (cddr rem)))]
-              [else
-               (set! body (car rem))
-               (loop (cdr rem))])))
-      ,body)))
+  (let ((classes (string-join (cons "btn" class) " "))
+        (body (remove-key-values args)))
+    (cond (href
+           `(a (@ (class ,classes)
+                  (href ,href))
+               ,@body))
+          (onclick
+           `(button (@ (class ,classes)
+                       (onclick ,onclick))
+                    ,@body))
+          (else
+           `(button (@ (class ,classes))
+                    ,@body)))))
 
 
 (define ((set-attribute attr) el)
diff --git a/module/calp/html/view/calendar/shared.scm b/module/calp/html/view/calendar/shared.scm
index cf930afc..4779d11b 100644
--- a/module/calp/html/view/calendar/shared.scm
+++ b/module/calp/html/view/calendar/shared.scm
@@ -9,8 +9,6 @@
   :use-module (hnh util tree)
   :use-module (datetime)
   :use-module (calp html config)
-  :use-module ((calp html components)
-               :select (btn))
   :use-module ((calp html vcomponent)
                :select (make-block format-summary))
   :use-module (ice-9 format)
diff --git a/tests/test/html/component.scm b/tests/test/html/component.scm
index 7d17be7f..a1fbdfbc 100644
--- a/tests/test/html/component.scm
+++ b/tests/test/html/component.scm
@@ -12,7 +12,7 @@
   (btn onclick: "onclick" "Body"))
 
 (test-equal "href button, without body"
-    '(a (@ (class "btn") (href "href")) #f)
+    '(a (@ (class "btn") (href "href")))
   (btn href: "href"))
 
 (test-error 'wrong-type-arg