dev.metalisp.sbt/src/main.lisp
2024-03-27 11:13:32 +01:00

134 lines
4.2 KiB
Common Lisp

;;;; -*- mode: lisp; coding: utf-8; tab-width: 4; fill-column: 100; indent-tabs-mode: nil; -*-
;;;; main.lisp
;;;; Provide general functions.
(defpackage dev.metalisp.sbt
(:use :cl)
(:export
:*l10n*
:find-l10n
:*use-cdn*
:*cdn-css-url*
:*cdn-js-url*
:*local-css-url*
:*local-js-url*
:*bs-version*
:*color-theme*
:download-bs-css
:download-bs-js
:write-html-to-file
:with-page))
(in-package :dev.metalisp.sbt)
(defparameter spinneret:*fill-column* 120)
(defparameter *bs-version* "5.3.2")
(defparameter *use-cdn* t)
(defparameter *cdn-css-url*
(concatenate 'string
"https://cdn.jsdelivr.net/npm/bootstrap@"
*bs-version*
"/dist/css/bootstrap.min.css"))
(defparameter *cdn-js-url*
(concatenate 'string
"https://cdn.jsdelivr.net/npm/bootstrap@"
*bs-version*
"/dist/js/bootstrap.bundle.min.js"))
(defparameter *bs-path*
(concatenate 'string
"public/"
*bs-version*
"/"))
(defparameter *local-css-url*
(concatenate 'string
*bs-path*
"bootstrap.min.css"))
(defparameter *local-js-url*
(concatenate 'string
*bs-path*
"bootstrap.bundle.min.js"))
(defparameter *color-theme* "dark")
(defun bs-css-url ()
(if *use-cdn*
*cdn-css-url*
*local-css-url*))
(defun bs-js-url ()
(if *use-cdn*
*cdn-js-url*
*local-js-url*))
(defun download-file (url directory)
"Downloads a file from a given URL and saves it to the specified directory."
(let* ((filename (car (last (uiop:split-string url :separator "/"))))
(filepath (merge-pathnames filename directory)))
(ensure-directories-exist directory)
(let ((content (dex:get url)))
(with-open-file (stream filepath
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(write-string content stream)))
filepath))
(defmacro define-download-function (name url directory)
`(defun ,name (&optional (directory ,directory))
(download-file ,url directory)))
(define-download-function download-bs-css *cdn-css-url* *bs-path*)
(define-download-function download-bs-js *cdn-js-url* *bs-path*)
(defun write-html-str-to-file (filename string &key (lang "en") (style :tree) (fc 120))
(let ((spinneret:*html-lang* lang)
(spinneret:*html-style* style)
(spinneret:*fill-column* fc))
(with-open-file (stream filename :direction :output :if-exists :supersede)
(write-string string stream))))
(defmacro with-page ((&key meta (title "Web page") main-con add-css-urls add-js-urls) &body body)
"This macro simplifies the process of creating an HTML web page.
META: The meta-information for the web page.
TITLE: Specifies the title of the web page. Defaults to 'Web page'.
MAIN-CON: If t add css class `container` to <main>.
ADD-CSS-URLS: An optional parameter for additional CSS file URLs.
ADD-JS-URLS: An optional parameter for additional JavaScript file URLs.
BODY: Denotes the markup for the body of the web page.
Example usage:
(with-page (:meta (:author \"John Doe\") :title \"My Page\" :main-con t) \"foo\")"
`(spinneret:with-html
(:doctype)
(:html :data-bs-theme ,*color-theme*
(:head (:meta :charset "utf-8")
(:meta :name "viewport" :content "width=device-width, initial-scale=1")
,@(loop for (key value) on meta by #'cddr
collect `(:meta :name
,(string-downcase (symbol-name key))
:content ,(getf meta key)))
(:title ,title)
(:link :type "text/css" :rel "stylesheet" :href ,(bs-css-url))
,@(loop for url in add-css-urls
collect `(:link :type "text/css" :rel "stylesheet" :href ,url)))
(:body (:h1 :class "visually-hidden" ,title)
(:main ,@(when main-con (list :class "container")) ,@body)
(:script :src ,(bs-js-url))
,@(loop for url in add-js-urls
collect `(:script :src ,url))))))