# (defpackage :cl-bbs/views (:use :cl) (:import-from :cl-who #:with-html-output-to-string #:htm #:str #:esc #:fmt) (:import-from :cl-bbs/storage #:is-board-locked) (:export #:render-index #:render-list #:render-thread #:render-preferences #:render-moderation #:render-error-page #:render-search-results #:render-playground #:preferences #:make-preferences #:preferences-theme #:preferences-syntax-theme #:preferences-default-board #:preferences-search-hide-input #:preferences-search-local-only #:preferences-search-position #:*preferences*)) (in-package :cl-bbs/views) (defstruct preferences (theme "dark") (syntax-theme "simple") (default-board "") (search-hide-input "no") (search-local-only "no") (search-position "top")) (defvar *preferences* (make-preferences)) (defun get-git-commit-hash () "Gets the git commit hash from environmental dynamics (APP_COMMIT_HASH) with a fallback to uiop:run-program." (let ((env-hash (uiop:getenv "APP_COMMIT_HASH"))) (if (and env-hash (string/= env-hash "")) env-hash (or (handler-case (string-trim '(#\Space #\Tab #\Newline #\Return) (uiop:run-program '("git" "rev-parse" "--short" "HEAD") :output :string)) (error () nil)) "unknown")))) (defun render-footer-html (&optional board) "Renders the common footer HTML with cl-bbs version hash and a GitHub link." (let ((hash (get-git-commit-hash))) (cl-who:with-html-output-to-string (s nil :indent t) (:p :class "footer" "cl-bbs version:" (:a :href (format nil "https://github.com/ryukinix/cl-bbs/commit/~a" hash) :target "_blank" (cl-who:esc hash)) " - " (:a :href (if board (format nil "/~a/rss" board) "/rss") :target "_blank" "RSS Feed"))))) (defun render-board-name (board) (cl-who:with-html-output-to-string (s nil :indent t) (:h1 (cl-who:esc (if (is-board-locked board) (concatenate 'string board " 🔒") board))))) (defun get-hash-hue (id-val) (let ((id-num (cond ((integerp id-val) id-val) ((stringp id-val) (or (handler-case (parse-integer id-val :junk-allowed t) (error () nil)) 0)) (t 0)))) (mod (* id-num 137) 360))) (defmacro layout (title class prefs &body body) `(cl-who:with-html-output-to-string (s nil :prologue "" :indent t) (:html (:head (:meta :charset "utf-8") (:meta :name "viewport" :content "width=device-width, initial-scale=1.0") (:title (cl-who:esc ,title)) (:link :rel "manifest" :href "/manifest.json") (:link :rel "icon" :href "/static/favicon.ico" :type "image/png") (:link :rel "stylesheet" :href (format nil "/static/styles/themes/~a.css" (or (preferences-theme ,prefs) "default")) :type "text/css") (:link :rel "stylesheet" :href (format nil "/static/styles/syntax/~a.css" (or (preferences-syntax-theme ,prefs) "simple")) :type "text/css") (:script "if ('serviceWorker' in navigator) { window.addEventListener('load', () => { navigator.serviceWorker.register('/sw.js'); }); }") (:script " function validatePostForm(form, errorId) { const content = form.epistula.value.trim(); const errorEl = document.getElementById(errorId); if (!content) { if (errorEl) { errorEl.textContent = 'Post body cannot be empty!'; errorEl.style.display = 'block'; } else { alert('Post body cannot be empty!'); } return false; } if (errorEl) { errorEl.style.display = 'none'; } return true; } document.addEventListener('DOMContentLoaded', function() { document.querySelectorAll('textarea[name=\"epistula\"]').forEach(function(ta) { ta.addEventListener('keydown', function(e) { if (e.ctrlKey && e.key === 'Enter') { e.preventDefault(); ta.form.requestSubmit(); } }); }); }); ") (:script :src "/static/jscl-snippets.js" :defer t)) (:body :class ,class (cl-who:str (render-boards-header)) (:hr) (cl-who:str (progn ,@body)) (when (show-search-at-bottom-p) (cl-who:htm (:hr) (cl-who:str (render-search-form)))))))) (defun render-error-page (error-message &optional (prefs *preferences*)) "Renders an HTML error page displaying the given ERROR-MESSAGE, using the specified layout PREFS." (layout "Error - cl-bbs" "error-page" prefs (cl-who:with-html-output-to-string (s nil :indent t) (:h1 "Error") (:hr) (:div :class "error-container" (:p :class "error-title" (cl-who:esc error-message)) (:p "We were unable to process your post because it does not meet the validation requirements.") (:p (:button :class "error-back-button" :onclick "history.back();" "← Go Back and Edit Post"))) (:hr) (cl-who:str (render-footer-html))))) (defun board-view-p (path) "Checks if the given PATH represents a board-specific view." (and path (string/= path "/") (string/= path "/index.html") (not (uiop:string-prefix-p "/search" path)) (not (uiop:string-prefix-p "/admin" path)) (not (uiop:string-prefix-p "/about" path)) (not (uiop:string-prefix-p "/sw.js" path)) (not (uiop:string-prefix-p "/manifest.json" path)) (not (uiop:string-prefix-p "/playground" path)))) (defun get-current-board-from-path (path) "Extracts the board name from the request PATH." (when (and path (string/= path "") (char= (char path 0) #\/)) (let ((parts (cl-ppcre:split "/" path))) (when (>= (length parts) 2) (let ((b (second parts))) (and (string/= b "") b)))))) (defun show-search-at-top-p () "Determines whether the search form should be rendered at the top header." (let* ((env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) (path (and env (getf env :path-info))) (is-board (board-view-p path))) (and (not (and is-board (string= (preferences-search-hide-input *preferences*) "yes"))) (string= (preferences-search-position *preferences*) "top")))) (defun show-search-at-bottom-p () "Determines whether the search form should be rendered at the bottom of the page." (and (not (string= (preferences-search-hide-input *preferences*) "yes")) (string= (preferences-search-position *preferences*) "bottom"))) (defun render-search-form () "Renders the search form as a standalone block, with board filter if local search is configured." (let* ((env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) (path (and env (getf env :path-info))) (board (and (board-view-p path) (get-current-board-from-path path)))) (cl-who:with-html-output-to-string (s nil :indent t) (:form :action "/search" :method "GET" :style "margin: 1em 2%; display: inline-flex;" (when (and (string= (preferences-search-local-only *preferences*) "yes") board) (cl-who:htm (:input :type "hidden" :name "board" :value board))) (:input :type "text" :name "q" :placeholder "Search posts..." :style "padding: 2px 5px; font-size: 0.85em; margin-right: 5px;") (:input :type "submit" :value "Search"))))) (defun render-boards-header () (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*)) (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) (boards (sort (mapcar (lambda (path) (car (last (pathname-directory path)))) paths) #'string<)) (env (and (boundp 'ningle:*request*) ningle:*request* (lack.request:request-env ningle:*request*))) (path (and env (getf env :path-info))) (board (and (board-view-p path) (get-current-board-from-path path)))) (cl-who:with-html-output-to-string (s nil :indent t) (:div :style "display: flex; justify-content: space-between; align-items: center; margin: 0.5em 2% 1em 2%;" (:p :class "boards" :style "font-size: 0.9em; margin: 0;" "[ " (loop for board in boards for i from 0 unless (zerop i) do (cl-who:str " | ") do (cl-who:htm (:a :href (format nil "/~a/" board) (cl-who:esc board)))) " ]") (when (show-search-at-top-p) (cl-who:htm (:form :action "/search" :method "GET" :style "margin: 0; display: inline-flex;" (when (and (string= (preferences-search-local-only *preferences*) "yes") board) (cl-who:htm (:input :type "hidden" :name "board" :value board))) (:input :type "text" :name "q" :placeholder "Search posts..." :style "padding: 2px 5px; font-size: 0.85em; margin-right: 5px;") (:input :type "submit" :value "Search")))))))) (defun render-menu (board selected) (cl-who:with-html-output-to-string (s nil :indent t) (:p :class "nav" (if (string= selected "front") (cl-who:str "front") (cl-who:htm (:a :href (format nil "/~a" board) "front"))) " - " (if (string= selected "list") (cl-who:str "list") (cl-who:htm (:a :href (format nil "/~a/list" board) "list"))) " - " (if (string= selected "front") (cl-who:htm (:a :href "#newthread" "new")) (cl-who:htm (:a :href (format nil "/~a#newthread" board) "new"))) " - " (:a :href (format nil "/~a/preferences" board) "preferences") " - " (if (string= selected "playground") (cl-who:str "λ") (cl-who:htm (:a :href (format nil "/~a/playground" board) "λ"))) " - " (:a :href "/index.html" "?")))) (defun render-thread-form (board) (cl-who:with-html-output-to-string (s nil :indent t) (:div :class "newthread-form" (:h2 :id "newthread" "New thread") (:p :id "newthread-error" :style "color: red; font-weight: bold; display: none;") (:form :action (format nil "/~a/post" board) :method "POST" :onsubmit "return validatePostForm(this, 'newthread-error');" (:p (:input :type "text" :name "titulus" :size 35 :placeholder "Headline")) (:p (:textarea :name "epistula" :rows 5 :cols 50 :placeholder "Message")) (:p (:input :type "text" :name "name" :style "display:none") (:input :type "text" :name "message" :style "display:none") (:input :type "submit" :value "Post")))))) (defun unescape-html (string) (let ((s string)) (setf s (cl-ppcre:regex-replace-all """ s "\"")) (setf s (cl-ppcre:regex-replace-all "<" s "<")) (setf s (cl-ppcre:regex-replace-all ">" s ">")) (setf s (cl-ppcre:regex-replace-all "'" s "'")) (setf s (cl-ppcre:regex-replace-all "'" s "'")) (setf s (cl-ppcre:regex-replace-all "'" s "'")) (setf s (cl-ppcre:regex-replace-all "&#[xX]([0-9a-fA-F]+);" s (lambda (match-string hex-str) (declare (ignore match-string)) (string (code-char (parse-integer hex-str :radix 16)))) :simple-calls t)) (setf s (cl-ppcre:regex-replace-all "&#([0-9]+);" s (lambda (match-string dec-str) (declare (ignore match-string)) (string (code-char (parse-integer dec-str :radix 10)))) :simple-calls t)) (setf s (cl-ppcre:regex-replace-all "&" s "&")) s)) (defun format-text (text &optional thread-id) (let* ((escaped (cl-who:escape-string text)) ;; 1. Extract code blocks (code-blocks '()) (code-block-placeholder-format "") (placeholder-idx 0) (processed escaped)) (setf processed (cl-ppcre:regex-replace-all "(?s)```\\n*(.*?)\\n*```" processed (lambda (match-string &optional content &rest others) (declare (ignore match-string others)) (let ((placeholder (format nil code-block-placeholder-format (incf placeholder-idx)))) (push (cons placeholder (or content "")) code-blocks) placeholder)) :simple-calls t)) (setf processed (cl-ppcre:regex-replace-all "(?m)^>(?!>)\\s*(.*?)$" processed "
\\1
")) (setf processed (cl-ppcre:regex-replace-all "\\*\\*(.*?)\\*\\*" processed "\\1")) (setf processed (cl-ppcre:regex-replace-all "__(.*?)__" processed "\\1")) (setf processed (cl-ppcre:regex-replace-all "`([^`]+)`" processed "\\1")) (setf processed (cl-ppcre:regex-replace-all "~~(.*?)~~" processed "\\1")) (setf processed (cl-ppcre:regex-replace-all ">>(\\d+)" processed (lambda (match-string &optional num &rest others) (declare (ignore match-string others)) (let ((num-val (or num ""))) (if thread-id (format nil ">>~a" thread-id num-val num-val) (format nil ">>~a" num-val num-val)))) :simple-calls t)) (setf processed (cl-ppcre:regex-replace-all "https?://[\\w\\-\\.\\/\\?\\=\\&\\%#\\+:\\;]+" processed "\\&")) (setf processed (cl-ppcre:regex-replace-all (concatenate 'string ".*?") processed (concatenate 'string "
" "
"))) (setf processed (cl-ppcre:regex-replace-all "image\\+.*?" processed (concatenate 'string "
" "
"))) (setf processed (cl-ppcre:regex-replace-all "\\r\\n" processed (string #\Newline))) (setf processed (cl-ppcre:regex-replace-all "\\n\\n+" processed "

")) (setf processed (cl-ppcre:regex-replace-all "\\n" processed "
")) (setf processed (format nil "

~a

" processed)) (dolist (pair code-blocks) (let ((placeholder (car pair)) (content (cdr pair))) (setf processed (cl-ppcre:regex-replace-all placeholder processed (lambda (match-string &optional regs) (declare (ignore match-string regs)) (multiple-value-bind (match-start match-end reg-starts reg-ends) (cl-ppcre:scan "^(?i)(lisp|cl|common-lisp)\\r?\\n" content) (declare (ignore reg-starts reg-ends)) (if match-start (let* ((escaped-code (subseq content match-end)) (raw-code (unescape-html escaped-code)) (colorized-code (handler-case (colorize:html-colorization :common-lisp raw-code) (error () (cl-who:escape-string raw-code))))) ;; Note: colorize already wraps the result in ... ;; We wrap it in
 but keep a data-raw-code attribute
                         ;; or just use content for JS execution. JSCL needs the raw text. To avoid JSCL trying
                         ;; to parse HTML, we'll embed the raw code in a hidden div, or rely on JS `textContent`
                         ;; which extracts raw text from nested HTML elements. `textContent` works well.
                         (format nil "

~a

" colorized-code)) (format nil "

~a

" content)))) :simple-calls t)))) (setf processed (cl-ppcre:regex-replace-all "

\\s*

" processed "")) processed)) (defun render-post-form (board thread-id) (let ((error-id (format nil "reply-error-~a" thread-id))) (cl-who:with-html-output-to-string (s nil :indent t) (:p :id error-id :style "color: red; font-weight: bold; display: none;") (:form :action (format nil "/~a/~a/post" board thread-id) :method "POST" :onsubmit (format nil "return validatePostForm(this, '~a');" error-id) (:p (:textarea :name "epistula" :rows 8 :cols 78 :placeholder "Message") (:br) (:input :type "text" :name "name" :class "name" :style "display:none") (:input :type "text" :name "message" :class "message" :style "display:none") (:input :type "submit" :value "Post")))))) (defun render-frontpage-thread (board thread-data index &optional (prefs *preferences*)) (let* ((thread-id (car thread-data)) (props (cdr thread-data)) (headline (cdr (assoc 'cl-bbs/models:headline props))) (posts (second (assoc 'cl-bbs/models:posts props))) (next-post-number (if posts (1+ (reduce #'max posts :key #'car :initial-value 0)) 1)) (truncated (cdr (assoc 'cl-bbs/models:truncated props))) (theme (preferences-theme prefs))) (cl-who:with-html-output-to-string (s nil :indent t) (:pre :class "jump" (:a :id (format nil "d~a" index) :href (if (= index 10) "#d1" (format nil "#d~a" (1+ index))) "↓") (cl-who:str " ")) (let ((heading-style (if (string= theme "colored") (format nil (concatenate 'string "border-left: 5px solid hsl(~D, 80%, 45%); " "padding-left: 10px; margin-left: 2%;") (get-hash-hue thread-id)) ""))) (cl-who:htm (:h2 :style heading-style (:a :href (format nil "/~a/~a" board thread-id) (cl-who:esc headline))))) (:dl (let ((prev-id nil)) (dolist (post posts) (let* ((post-id (car post)) (post-data (cdr post)) (content (cdr (assoc 'cl-bbs/models:content post-data))) (date (cdr (assoc 'cl-bbs/models:date post-data)))) (when (and prev-id (> post-id (1+ prev-id))) ;; Instead of hard assumption based just on IDs, actually check via truncated list if ;; the missing IDs are meant to be rendered as collapsed (i.e. they actually exist in the background). ;; Find the maximum contiguous subsegment of truncated IDs bridging prev-id and post-id. (let* ((missing-ids (loop for id from (1+ prev-id) to (1- post-id) collect id)) (actual-missing (if (listp truncated) (remove-if-not (lambda (id) (member id truncated)) missing-ids) missing-ids))) (when (>= (length actual-missing) 2) (let ((fst (car actual-missing)) (lst (car (last actual-missing)))) (cl-who:htm (:dt :class "collapsed" :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id fst) (cl-who:str (format nil "~D" fst))) (when (> lst fst) (cl-who:htm (cl-who:str "...") (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id lst) (cl-who:str (format nil "~D" lst))))))))))) (setf prev-id post-id) (let ((post-style (if (string= theme "colored") (let ((hue (get-hash-hue post-id))) (format nil (concatenate 'string "background-color: hsl(~D, 85%, 96%); " "border-left: 4px solid hsl(~D, 85%, 45%); " "padding: 0.5em 1em; " "margin: 0.3em 2% 1.2em 2%; " "border-radius: 0 4px 4px 0;") hue hue)) ""))) (cl-who:htm (:dt :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) :id (format nil "t~ap~a" thread-id post-id) (cl-who:str (format nil "~a" post-id))) " " (:samp (cl-who:esc date))) (:dd :style post-style (cl-who:str (format-text content thread-id)))))))) (unless (is-board-locked board) (cl-who:htm (:dt :style "margin: 0.5em 2%; margin-left: 0; padding-left: 0;" (:a :href (format nil "#t~ap~a" thread-id next-post-number) :id (format nil "t~ap~a" thread-id next-post-number) (cl-who:str (format nil "~a" next-post-number)))) (:dd (cl-who:str (render-post-form board thread-id)))))) (:hr)))) (defun render-index (board threads &optional (prefs *preferences*)) "Renders the board index (frontpage) HTML with the list of active THREADS and the new thread form, using layout PREFS." (layout (format nil "/~a/" board) nil prefs (cl-who:with-html-output-to-string (s nil :indent t) (cl-who:str (render-board-name board)) (cl-who:str (render-menu board "front")) (:hr) (loop for t-data in threads for i from 1 do (cl-who:htm (cl-who:str (render-frontpage-thread board t-data i prefs)))) (unless (is-board-locked board) (cl-who:htm (cl-who:str (render-thread-form board)))) (:hr) (cl-who:str (render-footer-html board))))) (defun render-list (board threads &optional (prefs *preferences*)) "Renders the board thread-list HTML page, showing all THREADS in tabular format, using layout PREFS." (layout (format nil "/~a/" board) nil prefs (cl-who:with-html-output-to-string (s nil :indent t) (cl-who:str (render-board-name board)) (cl-who:str (render-menu board "list")) (:hr) (:table :summary "Thread list" (:thead (:tr (:th "#") (:th "headline") (:th "posts") (:th "last update"))) (:tbody (loop for t-data in threads for i from 1 do (let* ((thread-id (car t-data)) (props (cdr t-data)) (headline (cdr (assoc 'cl-bbs/models:headline props))) (messages (cdr (assoc 'cl-bbs/models:messages props))) (date (cdr (assoc 'cl-bbs/models:date props)))) (cl-who:htm (:tr (:td (cl-who:str (format nil "~a" i))) (:td (:a :href (format nil "/~a/~a" board thread-id) (cl-who:esc headline))) (:td (cl-who:str (format nil "~a" messages))) (:td (:samp (cl-who:esc date))))))))) (:hr) (cl-who:str (render-footer-html board))))) (defun render-thread (board thread-id thread-data &optional range-string (prefs *preferences*)) "Renders a single thread page HTML for THREAD-ID under BOARD with THREAD-DATA (comments), optionally filtered by RANGE-STRING, using layout PREFS." (let* ((theme (preferences-theme prefs)) (raw-thread (if (and (consp thread-data) (consp (car thread-data)) (consp (caar thread-data))) (car thread-data) thread-data)) (headline (if (consp (car raw-thread)) (cdr (assoc 'cl-bbs/models:headline raw-thread)) (cdr (assoc 'cl-bbs/models:headline (list raw-thread))))) (posts-assoc (if (consp (car raw-thread)) (assoc 'cl-bbs/models:posts raw-thread) (cadr thread-data))) (posts-list (if (and posts-assoc (listp (cdr posts-assoc)) (not (keywordp (cdr posts-assoc)))) (if (listp (cadr posts-assoc)) (cadr posts-assoc) (cdr posts-assoc)) (cdr posts-assoc))) (posts (if (listp (car posts-list)) posts-list (list posts-list))) (next-post-number (if posts (1+ (reduce #'max posts :key #'car :initial-value 0)) 1)) (filter-func (if (and range-string (string/= range-string "")) (let ((allowed-ids (make-hash-table :test #'eql))) (dolist (part (cl-ppcre:split "," range-string)) (let ((subparts (cl-ppcre:split "-" part))) (cond ((= (length subparts) 1) (let ((id (parse-integer (first subparts) :junk-allowed t))) (when id (setf (gethash id allowed-ids) t)))) ((= (length subparts) 2) (let ((start (parse-integer (first subparts) :junk-allowed t)) (end (parse-integer (second subparts) :junk-allowed t))) (when (and start end (<= start end)) (loop for id from start to end do (setf (gethash id allowed-ids) t)))))))) (lambda (id) (gethash id allowed-ids))) (lambda (id) (declare (ignore id)) t)))) (layout (format nil "/~a/" board) "thread" prefs (cl-who:with-html-output-to-string (s nil :indent t) (cl-who:str (render-board-name board)) (cl-who:str (render-menu board "thread")) (:hr) (let ((heading-style (if (string= theme "colored") (format nil "border-left: 5px solid hsl(~D, 80%, 45%); padding-left: 10px;" (get-hash-hue thread-id)) ""))) (cl-who:htm (:h2 :style heading-style (cl-who:esc headline)))) (:dl (loop for post in posts for post-id = (car post) for post-data = (cdr post) for content = (cdr (assoc 'cl-bbs/models:content post-data)) for date = (cdr (assoc 'cl-bbs/models:date post-data)) when (funcall filter-func post-id) do (let ((post-style (if (string= theme "colored") (let ((hue (get-hash-hue post-id))) (format nil (concatenate 'string "background-color: hsl(~D, 85%, 96%); " "border-left: 4px solid hsl(~D, 85%, 45%); " "padding: 0.5em 1em; margin: 0.3em 0 1.2em 0; " "border-radius: 0 4px 4px 0;") hue hue)) ""))) (cl-who:htm (:dt (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) :id (format nil "t~ap~a" thread-id post-id) (cl-who:str (format nil "~a" post-id))) " " (:samp (cl-who:esc date))) (:dd :style post-style (cl-who:str (format-text content thread-id)))))) (unless (is-board-locked board) (cl-who:htm (:dt (:a :href (format nil "#t~ap~a" thread-id next-post-number) :id (format nil "t~ap~a" thread-id next-post-number) (cl-who:str (format nil "~a" next-post-number)))) (:dd (cl-who:str (render-post-form board thread-id)))))) (:hr) (cl-who:str (render-footer-html board)))))) (defun render-preferences (board &optional (prefs *preferences*)) "Renders the board preferences HTML page, allowing users to choose a custom stylesheet THEME, default-board and search configuration." (let* ((sexp-dir (merge-pathnames "sexp/" cl-bbs/storage:*base-dir*)) (paths (and (probe-file sexp-dir) (uiop:subdirectories sexp-dir))) (boards (sort (mapcar (lambda (path) (car (last (pathname-directory path)))) paths) #'string<)) (theme (preferences-theme prefs)) (syntax-theme (preferences-syntax-theme prefs)) (default-board (preferences-default-board prefs)) (search-hide-input (preferences-search-hide-input prefs)) (search-local-only (preferences-search-local-only prefs)) (search-position (preferences-search-position prefs))) (layout (format nil "/~a/ - Preferences" board) "preferences" prefs (cl-who:with-html-output-to-string (s nil :indent t) (cl-who:str (render-board-name board)) (cl-who:str (render-menu board "preferences")) (:hr) (:h2 "Preferences") (:form :action (format nil "/~a/preferences" board) :method "POST" :class "preferences-form" (:div :style "margin-bottom: 2em;" (:h3 :style "margin-bottom: 0.5em;" "Style Theme") (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" "Customize the look and feel of the textboard.") (:div :class "theme-selector-container" (dolist (item '("default" "dark" "no" "colored" "matrix")) (cl-who:htm (:label :class "theme-option-label" :style "margin-right: 15px;" (:input :type "radio" :name "theme" :value item :checked (and theme (string= theme item)) :onchange "updateThemePreview(this.value)") (:span :class "theme-option-text" (cl-who:str item))))))) (:div :style "margin-bottom: 2em;" (:h3 :style "margin-bottom: 0.5em;" "Syntax Theme") (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" "Choose syntax highlighting color scheme for Lisp code.") (:div :class "syntax-theme-selector-container" (dolist (item '("simple" "colorful")) (cl-who:htm (:label :class "theme-option-label" :style "margin-right: 15px;" (:input :type "radio" :name "syntax_theme" :value item :checked (and syntax-theme (string= syntax-theme item))) (:span :class "theme-option-text" (cl-who:str item))))))) (:div :style "margin-bottom: 2em;" (:h3 :style "margin-bottom: 0.5em;" "Default Board") (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" "Select the board you land on when visiting the root domain.") (:div :class "board-selector-container" (:select :name "default_board" :style "padding: 4px; font-size: 0.95em;" (:option :value "" :selected (or (null default-board) (string= default-board "")) "None (Main Page)") (dolist (item boards) (cl-who:htm (:option :value item :selected (and default-board (string= default-board item)) (cl-who:str (format nil "/~a/" item)))))))) (:div :style "margin-bottom: 2em;" (:h3 :style "margin-bottom: 0.5em;" "Search Settings") (:p :style "color: #555; font-size: 0.9em; margin-bottom: 0.8em;" "Configure how the search bar behaves on board indices and thread views.") (:div :class "search-preferences-container" :style "line-height: 1.8em;" (:div :style "margin-bottom: 0.8em;" (:label :style "font-weight: bold;" "Hide search input in board view: ") (:br) (:select :name "search_hide_input" :style "padding: 4px; font-size: 0.95em;" (:option :value "no" :selected (string= search-hide-input "no") "No") (:option :value "yes" :selected (string= search-hide-input "yes") "Yes"))) (:div :style "margin-bottom: 0.8em;" (:label :style "font-weight: bold;" "Only make local searches in the current board: ") (:br) (:select :name "search_local_only" :style "padding: 4px; font-size: 0.95em;" (:option :value "no" :selected (string= search-local-only "no") "No (Global)") (:option :value "yes" :selected (string= search-local-only "yes") "Yes (Local)"))) (:div :style "margin-bottom: 0.8em;" (:label :style "font-weight: bold;" "Placement of search input: ") (:br) (:select :name "search_position" :style "padding: 4px; font-size: 0.95em;" (:option :value "top" :selected (string= search-position "top") "Top (Header)") (:option :value "bottom" :selected (string= search-position "bottom") "Bottom (Footer)"))))) (:p :style "margin-top: 2em;" (:input :type "submit" :value "Save Preferences"))) (:script " function updateThemePreview(themeValue) { // Find all stylesheet links const links = document.querySelectorAll('link[rel=\"stylesheet\"]'); for (const link of links) { if (link.href.includes('/static/styles/themes/')) { link.href = '/static/styles/themes/' + themeValue + '.css'; } } } ") (:hr) (cl-who:str (render-footer-html)))))) (defun render-moderation (boards &optional board threads thread comments (prefs *preferences*) headline) "Renders the admin/moderation control panel HTML page showing BOARDS and allowing deletions/edits." (layout "cl-bbs Moderation Panel" "moderation" prefs (cl-who:with-html-output-to-string (s nil :indent t) (:h1 "Moderation Panel") (:p (:a :href "/" "Back to Home")) (:hr) (:h2 "Boards") (:ul (dolist (b boards) (cl-who:htm (:li (:strong (:a :href (format nil "/admin?board=~a" b) (cl-who:esc b))) "   " (:form :action "/admin/action" :method "POST" :style "display:inline;" (:input :type "hidden" :name "action" :value "delete-board") (:input :type "hidden" :name "board" :value b) (:input :type "submit" :value "Delete Board" :class "delete-button" :onclick (concatenate 'string "return confirm('Are you sure you want to " "delete the ENTIRE board? " "This cannot be undone.');"))))))) (:h2 "Create Board") (:p "Enter a board name below to create a new board. Board names must be in " (:strong "kebab-case") " (only lowercase letters, numbers, and hyphens; no spaces or underlines).") (:div :style "margin: 1em 0;" (:form :action "/admin/action" :method "POST" :onsubmit "return validateCreateBoard()" (:input :type "hidden" :name "action" :value "create-board") (:input :type "text" :name "board" :id "new-board-name" :placeholder "board-name" :style "padding: 6px; font-size: 1em; border: 1px solid #bababa; border-radius: 4px; font-family: monospace;") " " (:input :type "submit" :value "Create Board")) (:p :id "board-error" :style "color: red; font-size: 0.9em; margin: 0.5em 0; display: none;")) (:script :type "text/javascript" "function validateCreateBoard() { const input = document.getElementById('new-board-name'); const error = document.getElementById('board-error'); const boardName = input.value.trim(); // Regex for kebab-case (lowercase alphanumeric and hyphens only, no start/end hyphens) const kebabRegex = /^[a-z0-9]+(?:-[a-z0-9]+)*$/; if (!boardName) { error.textContent = 'Please enter a board name.'; error.style.display = 'block'; return false; } if (!kebabRegex.test(boardName)) { error.textContent = 'Invalid board name! Must contain only lowercase ' + 'alphanumeric characters and hyphens (e.g. \"lisp-board\", no spaces, ' + 'underlines or capitals).'; error.style.display = 'block'; return false; } error.style.display = 'none'; return true; }") (when board (cl-who:htm (:hr) (:h2 (cl-who:fmt "Threads in /~a/" board)) (if threads (cl-who:htm (:table :border 1 :cellpadding 5 (:thead (:tr (:th "ID") (:th "Headline") (:th "Date") (:th "Actions"))) (:tbody (dolist (t-data threads) (let* ((tid (car t-data)) (props (cdr t-data)) (headline (cdr (assoc 'cl-bbs/models:headline props)))) (cl-who:htm (:tr (:td (cl-who:str (format nil "~a" tid))) (:td (:a :href (format nil "/admin?board=~a&thread=~a" board tid) (cl-who:esc headline))) (:td (cl-who:str (format nil "~a" (cdr (assoc 'cl-bbs/models:date props))))) (:td (:form :action "/admin/action" :method "POST" :style "display:inline;" (:input :type "hidden" :name "action" :value "delete-thread") (:input :type "hidden" :name "board" :value board) (:input :type "hidden" :name "thread" :value tid) (:input :type "submit" :value "Delete Thread" :class "delete-button" :onclick (concatenate 'string "return confirm('Are you sure you want " "to delete this thread?');"))) (unless (string-equal board "shame") (cl-who:htm (:form :action "/admin/action" :method "POST" :style "display:inline; margin-left: 5px;" (:input :type "hidden" :name "action" :value "shame-thread") (:input :type "hidden" :name "board" :value board) (:input :type "hidden" :name "thread" :value tid) (:input :type "submit" :value "Shame" :class "shame-button" :onclick (concatenate 'string "return confirm('Are you sure you want " "to move this thread to the shame " "board?');"))))))))))))) (cl-who:htm (:p "No threads found on this board."))))) (when (and board thread) (cl-who:htm (:hr) (:h2 (cl-who:fmt "Comments in Thread #~a (~a)" thread board)) (if comments (cl-who:htm (:dl (dolist (p comments) (let* ((pid (car p)) (pdata (cdr p)) (content (cdr (assoc 'cl-bbs/models:content pdata))) (date (cdr (assoc 'cl-bbs/models:date pdata)))) (cl-who:htm (:dt "No." (cl-who:str (format nil "~a" pid)) " " (:samp (cl-who:esc date)) "   " (:form :action "/admin/action" :method "POST" :style "display:inline;" (:input :type "hidden" :name "action" :value "delete-comment") (:input :type "hidden" :name "board" :value board) (:input :type "hidden" :name "thread" :value thread) (:input :type "hidden" :name "comment" :value pid) (:input :type "submit" :value "Delete Comment" :class "delete-button" :onclick "return confirm('Are you sure you want to delete this comment?');"))) (:dd (:div :class "comment-preview" (cl-who:str (format-text content thread))) (:form :action "/admin/action" :method "POST" :style "margin-top: 0.5em;" (:input :type "hidden" :name "action" :value "edit-comment") (:input :type "hidden" :name "board" :value board) (:input :type "hidden" :name "thread" :value thread) (:input :type "hidden" :name "comment" :value pid) (when (and (= pid 1) headline) (cl-who:htm (:p (:label :for "headline" "Thread Headline: ") (:br) (:input :type "text" :name "headline" :id "headline" :size 60 :value headline)))) (:textarea :name "content" :rows 3 :cols 60 (cl-who:str content)) (:br) (:input :type "submit" :value "Save Changes")))))))) (cl-who:htm (:p "No comments found.")))))))) (defun render-search-results (query results &optional (prefs *preferences*)) "Renders the search results page HTML, showing matching posts for the given QUERY, using layout PREFS." (let ((theme (preferences-theme prefs))) (layout (format nil "Search: ~a" query) "search-results" prefs (cl-who:with-html-output-to-string (s nil :indent t) (:h1 "Search Results") (:p :style "margin: 0.5em 2%;" (:button :class "lisp-btn" :onclick "history.back();" "← Go Back") " - Query: " (:strong (cl-who:esc query))) (:hr) (if (null results) (cl-who:htm (:p :style "margin: 2em; text-align: center;" "No results found matching your query.")) (cl-who:htm (:dl :style "margin: 1em 2%;" (dolist (match results) (let* ((board (getf match :board)) (thread-id (getf match :thread-id)) (headline (getf match :headline)) (post-id (getf match :post-id)) (date (getf match :date)) (content (getf match :content)) (post-style (if (string= theme "colored") (let ((hue (get-hash-hue post-id))) (format nil (concatenate 'string "background-color: hsl(~D, 85%, 96%); " "border-left: 4px solid hsl(~D, 85%, 45%); " "padding: 0.5em 1em; " "margin: 0.3em 0 1.2em 0; " "border-radius: 0 4px 4px 0;") hue hue)) ""))) (cl-who:htm (:dt :style "margin-top: 1.5em; font-size: 0.95em;" "[" (:a :href (format nil "/~a/" board) (cl-who:esc board)) "] " (:a :href (format nil "/~a/~a" board thread-id) (:strong (cl-who:esc headline))) " - Post " (:a :href (format nil "/~a/~a#t~ap~a" board thread-id thread-id post-id) (cl-who:str (format nil "#~a" post-id))) " " (:samp (cl-who:esc date))) (:dd :style post-style (cl-who:str (format-text content thread-id))))))))) (:hr) (cl-who:str (render-footer-html)))))) (defun render-playground (&optional board (prefs *preferences*)) "Renders the interactive Common Lisp playground view." (layout (if board (format nil "/~a/ - Lisp Playground" board) "Lisp Playground") "playground-page" prefs (cl-who:with-html-output-to-string (s nil :indent t) (when board (cl-who:htm (cl-who:str (render-menu board "playground")))) (:h2 "Common Lisp Playground") (:p :style "margin: 0.5em 2%; font-size: 0.95em;" "Write and execute Common Lisp code directly in your browser using " (:a :href "https://github.com/jscl-project/jscl" :target "_blank" "JSCL") ". Everything runs completely client-side in a sandboxed environment.") (:div :class "playground-container" :style "margin: 1.5em 2%;" (:div :style "margin-bottom: 1em; display: flex; gap: 10px; align-items: center; flex-wrap: wrap;" (:span "Load Example: ") (:select :id "playground-examples" :style "padding: 4px;" (:option :value "" "-- Select Example --") (:option :value "hello" "Hello World") (:option :value "fib" "Fibonacci Numbers") (:option :value "loop" "Loop Macro") (:option :value "clos" "Common Lisp Object System (CLOS)"))) (:div :id "example-data-hello" :style "display:none;" (cl-who:str (colorize:html-colorization :common-lisp "(format t \"Hello, World!~%\")"))) (:div :id "example-data-fib" :style "display:none;" (cl-who:str (colorize:html-colorization :common-lisp "(defun fib (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (format t \"Fibonacci of 10 is: ~a~%\" (fib 10))"))) (:div :id "example-data-loop" :style "display:none;" (cl-who:str (colorize:html-colorization :common-lisp "(loop for x from 1 to 5 do (format t \"Square of ~d is ~d~%\" x (* x x)))"))) (:div :id "example-data-clos" :style "display:none;" (cl-who:str (colorize:html-colorization :common-lisp "(defclass person () ((name :accessor person-name :initarg :name) (age :accessor person-age :initarg :age))) (defmethod introduce ((p person)) (format t \"Hi, I am ~a and I am ~a years old.~%\" (person-name p) (person-age p))) (let ((p (make-instance 'person :name \"Alice\" :age 30))) (introduce p))"))) (:pre :id "playground-editor" :class "lisp-code-block" :contenteditable "true" :spellcheck "false" :style (concatenate 'string "min-height: 200px; width: 96%; max-width: 800px; " "font-family: monospace; font-size: 1.1em; padding: 10px; " "border: 1px solid currentColor; background: transparent; " "color: inherit; margin-bottom: 1em; outline: none; " "overflow: auto; white-space: pre-wrap;") "") (:div :style "display: flex; gap: 10px; margin-bottom: 1em;" (:button :id "playground-run" :class "lisp-btn" "Run Code") (:button :id "playground-clear" :class "lisp-btn" "Clear Output")) (:h3 "Output Console") (:pre :id "playground-output" :style (concatenate 'string "display: none; padding: 10px; width: 96%; max-width: 800px; " "border: 1px dashed currentColor; " "background-color: rgba(128, 128, 128, 0.05); white-space: pre-wrap; " "word-break: break-all; font-family: monospace; font-size: 1.1em; " "line-height: 1.4em;") "")) (:hr) (cl-who:str (render-footer-html)))))