diff options
Diffstat (limited to 'module/calp/html/components.scm')
| -rw-r--r-- | module/calp/html/components.scm | 127 |
1 files changed, 127 insertions, 0 deletions
diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm new file mode 100644 index 00000000..49f00e52 --- /dev/null +++ b/module/calp/html/components.scm @@ -0,0 +1,127 @@ +(define-module (calp html components) + :use-module (util) + :use-module (util exceptions) + :export (xhtml-doc) + ) + +;; Wraps a number of sxml forms into a valid sxhtml-tree. +(define-syntax xhtml-doc + (syntax-rules (@) + ((_ (@ attr ...) body ...) + `(*TOP* + (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") + (html (@ (xmlns "http://www.w3.org/1999/xhtml") attr ...) + body ...))) + ((_ body ...) + (xhtml-doc (@) body ...)))) + + +;; Add a slider with an associated number input. Keeps the two in check. +;; Uses the js function setVar (which must be provided elsewhere) +;; set the the value of @var{variable}. +(define*-public (slider-input key: variable + (min 0) + (max 10) + (step 1) + (value 1) + (unit "")) + (let ((groupname (symbol->string (gensym "slider")))) + `(div (@ (class "input-group")) + (script + "function " ,groupname "fn (value) {" + "setVar('" ,variable "', value + '" ,unit "');" + "for (let el of document.getElementsByClassName('" ,groupname "')) {" + " el.value = value;" + "}}") + (input (@ (type "range") + (class ,groupname) + (min ,min) + (max ,max) + (step ,step) + (value ,value) + (oninput ,groupname "fn(this.value)") + )) + (input (@ (type "number") + (class ,groupname) + (min ,min) + (max ,max) + (step ,step) + (value ,value) + (oninput ,groupname "fn(this.value)")) + )))) + +;; Generates a button or button-like link. +;; TODO <div/> inside <button/> isn't valid. +(define*-public (btn key: onclick href (class '()) + allow-other-keys: + rest: args) + (when (and onclick href) + (error "Only give one of onclick, href and submit.")) + + (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))]))) + (div ,body)))) + + +;; Creates a group of tabs from a given specification. The specification +;; @var{elements} should be a list, where each element is a sublist on +;; the form +;; @example +;; ("tab icon" arguments ... tab-body) +;; @end example +;; where arguments are zero or more pairs of keyword arguments. For example: +;; @example +;; ("📅" title: "Översikt" ,(fmt-single-event ev)) +;; @end example +;; Creates a tab with an calendar emoji as icon, "Översikt" is sent as the +;; extra argument #:title, and the body is the return from fmt-single-event. +(define-public (tabset elements) + (define tabgroup (symbol->string (gensym "tabgroup"))) + + `(div (@ (class "tabgroup")) + ,@(for (i (key args ... body)) in (enumerate elements) + (define id (symbol->string (gensym "tab"))) + `(div (@ (class "tab")) + (input (@ (type "radio") (id ,id) (name ,tabgroup) + ,@(when (zero? i) '((checked))))) + ;; It would be preferable to place the labels in a separate + ;; div and set that to have fixed position, since we could + ;; then just flow them. That hovever doesn't work since we + ;; need a css-selector for the label to the selected radio + ;; option. + (label (@ ,@(assq-merge `((for ,id) + (style "top: calc(var(--tab-size) * " ,i ")")) + (kvlist->assq args))) + ,key) + (div (@ (class "content")) ,body))))) + + +(define-public (include-css path . extra-attributes) + `(link (@ (type "text/css") + (rel "stylesheet") + (href ,path) + ,@extra-attributes))) + + +(define-public (include-alt-css path . extra-attributes) + `(link (@ (type "text/css") + (rel "alternate stylesheet") + (href ,path) + ,@extra-attributes))) |