258 lines
7.6 KiB
Common Lisp
258 lines
7.6 KiB
Common Lisp
;;;; -*- mode: lisp; coding: utf-8; fill-column: 84; indent-tabs-mode: nil; -*-
|
|
;;;; main.lisp
|
|
;;;; Provide general functions.
|
|
|
|
(defpackage dev.metalisp.sbt
|
|
(:use :cl)
|
|
(:import-from #:spinneret #:*html-lang*)
|
|
(:export
|
|
:*l10n*
|
|
:find-l10n
|
|
:*use-cdn*
|
|
:*cdn-url-css*
|
|
:*cdn-url-js*
|
|
:*local-css-url*
|
|
:*local-url-js*
|
|
:*bs-version*
|
|
:*color-theme*
|
|
:bs-url-css
|
|
:bs-url-js
|
|
:download-bs-css
|
|
:download-bs-js
|
|
:write-html-to-file
|
|
:with-page
|
|
:body-header
|
|
:body-main
|
|
:remove-special-chars
|
|
:clean-form-str
|
|
:build-str-name
|
|
:build-str-value
|
|
:build-str-value-prop
|
|
:build-str-class
|
|
:build-str-id))
|
|
|
|
(in-package :dev.metalisp.sbt)
|
|
|
|
(defparameter *document-root-dir*
|
|
"public/"
|
|
"Defines directory name for use in document-root to serve static files.")
|
|
|
|
(defparameter spinneret:*fill-column* 120)
|
|
|
|
(defparameter *bs-version* "5.3.2")
|
|
|
|
(defparameter *use-cdn* t)
|
|
|
|
(defparameter *cdn-url-css*
|
|
(concatenate 'string
|
|
"https://cdn.jsdelivr.net/npm/bootstrap@"
|
|
*bs-version*
|
|
"/dist/css/bootstrap.min.css"))
|
|
|
|
(defparameter *cdn-url-js*
|
|
(concatenate 'string
|
|
"https://cdn.jsdelivr.net/npm/bootstrap@"
|
|
*bs-version*
|
|
"/dist/js/bootstrap.bundle.min.js"))
|
|
|
|
(defparameter *bs-path*
|
|
(concatenate 'string
|
|
"/"
|
|
*bs-version*
|
|
"/"))
|
|
|
|
(defparameter *local-url-css*
|
|
(concatenate 'string
|
|
*bs-path*
|
|
"bootstrap.min.css")
|
|
"Constructs path for HTML to load local bootstrap css from disk.")
|
|
|
|
(defparameter *local-url-js*
|
|
(concatenate 'string
|
|
*bs-path*
|
|
"bootstrap.bundle.min.js")
|
|
"Constructs path for HTML to load local bootstrap js from disk.")
|
|
|
|
(defparameter *color-theme* "light")
|
|
|
|
(defun bs-url-css ()
|
|
(if *use-cdn*
|
|
*cdn-url-css*
|
|
*local-url-css*))
|
|
|
|
(defun bs-url-js ()
|
|
(if *use-cdn*
|
|
*cdn-url-js*
|
|
*local-url-js*))
|
|
|
|
(defun bs-download-full-path ()
|
|
(truename (concatenate 'string *document-root-dir* *bs-version*)))
|
|
|
|
(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-url-css* (bs-download-full-path))
|
|
(define-download-function download-bs-js *cdn-url-js* (bs-download-full-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-string
|
|
(: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-url-css))
|
|
,@(loop for url in add-css-urls
|
|
collect `(:link :type "text/css"
|
|
:rel "stylesheet" :href ,url)))
|
|
(:body ,@body)
|
|
|
|
(:script :src ,(bs-url-js))
|
|
,@(loop for url in add-js-urls
|
|
collect `(:script :src ,url)))))
|
|
|
|
(defmacro body-header (main-heading &body body)
|
|
`(spinneret:with-html
|
|
(:header
|
|
(:div :class "container text-center py-3"
|
|
(:a :href "#main-content"
|
|
:class "skip-link"
|
|
(find-l10n "skip-link" *html-lang* *l10n*)))
|
|
,@body
|
|
(:h1 :class "container" ,main-heading))))
|
|
|
|
(defmacro body-main (&optional main-con &body body)
|
|
`(spinneret:with-html
|
|
(:main :id "main-content"
|
|
,@(when main-con (list :class "container"))
|
|
,@body)))
|
|
|
|
|
|
(defun remove-special-chars (str)
|
|
"Removes all special characters from the string STR except numbers and alphabets.
|
|
|
|
STR: The input string from which special characters need to be removed.
|
|
|
|
Example:
|
|
(remove-special-chars \"a1b!@#$%^&*()c2\") will return \"a1bc2\"
|
|
|
|
Returns:
|
|
A new string with special characters removed."
|
|
(remove-if-not (lambda (char)
|
|
(or (alpha-char-p char) (digit-char-p char)))
|
|
str))
|
|
|
|
(defun clean-form-str (str)
|
|
"Cleans a form string for use as a name or identifier.
|
|
|
|
STR: The string to clean. Removes leading and trailing spaces, replaces spaces
|
|
with dashes, and converts to lowercase.
|
|
|
|
Returns:
|
|
A new string which can be used as HTML class."
|
|
(string-downcase (substitute #\- #\Space (string-trim '(#\Space) str))))
|
|
|
|
(defun build-str-name (name)
|
|
"Builds a standardized string by adding a 'group-' prefix and applying cleaning
|
|
functions.
|
|
|
|
NAME: The initial name string.
|
|
|
|
Returns:
|
|
A new standardized string."
|
|
(concatenate 'string "group-" (clean-form-str name)))
|
|
|
|
(defun build-str-value (value)
|
|
"Trims leading and trailing spaces from the given value string.
|
|
|
|
VALUE: The string to be cleaned.
|
|
|
|
Returns:
|
|
A new string without leading and trailing spaces."
|
|
(string-trim '(#\Space) value))
|
|
|
|
(defun build-str-value-prop (value)
|
|
"Builds a value property string by applying various cleaning functions.
|
|
|
|
VALUE: The initial value string.
|
|
|
|
Returns:
|
|
A new value property string."
|
|
(clean-form-str (build-str-value value)))
|
|
|
|
(defun build-str-class (class name)
|
|
"Builds a class string by concatenating 'form-check-label' and a standardized
|
|
name string.
|
|
|
|
CLASS: Corresponding class property.
|
|
|
|
NAME: The initial name string.
|
|
|
|
Returns:
|
|
A new class string."
|
|
(concatenate 'string class " " (build-str-name name)))
|
|
|
|
(defun build-str-id (name value)
|
|
"Builds an ID string by concatenating a standardized name string and a sanitized
|
|
value property string.
|
|
|
|
NAME: The initial name string.
|
|
|
|
VALUE: The initial value string.
|
|
|
|
Returns:
|
|
A new ID string."
|
|
(concatenate 'string
|
|
(build-str-name name)
|
|
"-"
|
|
(remove-special-chars (build-str-value-prop value))))
|