Bubblegumdrop/cl-chat-web
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Navbar, messing with HTML.

Browse Source
This commit is contained in:
Bubblegumdrop 2024-10-13 01:26:33 -04:00
parent 0dbf9c90a6
commit ff1106123f
2 changed files with 32 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
live-chat-ui.lisp
View File

@ -59,13 +59,29 @@
(cl-who:str (render-chat-messages))))) (cl-who:str (render-chat-messages)))))
(:nav :role "navigation" (:nav :role "navigation"
:class "navbar is-fixed-bottom is-spaced has-shadow" :class "navbar is-fixed-bottom is-spaced has-shadow"
:aria-label "main navigation"
(:div :class "navbar-brand"
(:a :class "navbar-item"
:href "https://phntsm.ddns.net/"
(:img :src "/favicon.png"
:alt "icon"))
(:a :role "button"
:class "navbar-burger"
:aria-label "menu"
:aria-expanded "false"
:data-target "navbarBasicExample"
(:span :aria-hidden "true")
(:span :aria-hidden "true")
(:span :aria-hidden "true")
(:span :aria-hidden "true")))
(:div :class "navbar-menu is-active" (:div :class "navbar-menu is-active"
:id "navbarBasicExample" :id "navbarBasicExample"
(:div :class "navbar-start") (:div :class "navbar-start"
(:div :class "container" :style "display: none;")
(:div :class "navbar-middle container"
(:div :class "field has-addons" (:div :class "field has-addons"
(:div :class "control is-expanded" (:div :class "control is-expanded"
(:input :class "input is-expanded" (:input :class "input"
:id "chat-input" :id "chat-input"
:autocomplete "off" :autocomplete "off"
:placeholder "Enter your message..." :placeholder "Enter your message..."
@ -73,7 +89,8 @@
(:div :class "control" (:div :class "control"
(:button :class "button is-link is-light" (:button :class "button is-link is-light"
:type "submit" "Send")))) :type "submit" "Send"))))
(:div :class "navbar-end"))) (:div :class "navbar-end"
:style "display: none;")))
(:script (cl-who:str (js-snippet (subpath-prefix "/ws-chat-messages")))))))) (:script (cl-who:str (js-snippet (subpath-prefix "/ws-chat-messages"))))))))
(defun js-snippet (path) (defun js-snippet (path)

20
live-chat-ws.lisp
View File

@ -12,23 +12,25 @@
(setf (gethash con *connections*) (setf (gethash con *connections*)
(princ-to-string (gensym "USER-")))) (princ-to-string (gensym "USER-"))))
(defun generate-html-message (content)
(cl-who:with-html-output-to-string (*standard-output*)
(:div :class "box"
:style "overflow: auto; white-space: nowrap;"
(cl-who:str content))))
(defun broadcast-to-room (connection message) (defun broadcast-to-room (connection message)
(handle-post-message message) (handle-post-message message)
(let ((message (let ((message
(cl-who:with-html-output-to-string (*standard-output*) (generate-html-message
(:div :class "box" (format nil "~a: ~a" (gethash connection *connections*) message))))
:style "overflow: auto; white-space: nowrap;"
(format t "~a: ~a" (gethash connection *connections*) message)))))
(loop :for con :being :the :hash-key :of *connections* :do (loop :for con :being :the :hash-key :of *connections* :do
(send con message)))) (send con message))))
(defun handle-close-connection (connection) (defun handle-close-connection (connection)
(let ((message (let ((message
(cl-who:with-html-output-to-string (*standard-output*) (generate-html-message
(:div :class "box" (format nil "... ~a disconnected."
:style "overflow: auto; white-space: nowrap;" (gethash connection *connections*)))))
(format t "... ~a disconnected."
(gethash connection *connections*))))))
(loop :for con :being :the :hash-key :of *connections* :do (loop :for con :being :the :hash-key :of *connections* :do
(send con message)))) (send con message))))