| 1 |
(in-package :bos.web) |
|---|
| 2 |
|
|---|
| 3 |
(enable-interpol-syntax) |
|---|
| 4 |
|
|---|
| 5 |
(defclass bos-website (website) |
|---|
| 6 |
()) |
|---|
| 7 |
|
|---|
| 8 |
(defmethod website-show-page ((website bos-website) fn title) |
|---|
| 9 |
(html |
|---|
| 10 |
(:html |
|---|
| 11 |
(:head |
|---|
| 12 |
(bknr.web::header :title title)) |
|---|
| 13 |
((:body :class "cms" :onload "init();") |
|---|
| 14 |
((:div :class "navigation") |
|---|
| 15 |
(bknr.web::logo) |
|---|
| 16 |
(:h1 (:princ-safe (website-name website))) |
|---|
| 17 |
(bknr.web::navigation)) |
|---|
| 18 |
(:h1 (:princ-safe title)) |
|---|
| 19 |
(funcall fn) |
|---|
| 20 |
(website-session-info website))))) |
|---|
| 21 |
|
|---|
| 22 |
(defmethod website-session-info ((website bos-website)) |
|---|
| 23 |
(html :br :hr |
|---|
| 24 |
((:p :class "footer") |
|---|
| 25 |
"local time is " (:princ-safe (format-date-time)) |
|---|
| 26 |
" - " |
|---|
| 27 |
(if (bknr-session-user) |
|---|
| 28 |
(html "logged in as " (html-link (bknr-session-user))) |
|---|
| 29 |
(html "not logged in")) |
|---|
| 30 |
" - current content language is " |
|---|
| 31 |
(cmslink "change-language" |
|---|
| 32 |
(:princ-safe (request-language)) |
|---|
| 33 |
" (" |
|---|
| 34 |
(:princ-safe (language-name (request-language))) |
|---|
| 35 |
")")))) |
|---|
| 36 |
|
|---|
| 37 |
(defun language-name (language-short-name) |
|---|
| 38 |
(cadr (assoc language-short-name (website-languages) :test #'equal))) |
|---|
| 39 |
|
|---|
| 40 |
(defun content-language-chooser () |
|---|
| 41 |
(html |
|---|
| 42 |
((:p :class "languages") |
|---|
| 43 |
"Content languages: " |
|---|
| 44 |
(loop for (language-symbol language-name) in (website-languages) |
|---|
| 45 |
do (labels ((show-language-link () |
|---|
| 46 |
(html (cmslink (with-output-to-string (out) |
|---|
| 47 |
(write-string (hunchentoot:script-name*) out) |
|---|
| 48 |
;; write language param and remaining get params |
|---|
| 49 |
(write-string "?language=" out) |
|---|
| 50 |
(write-string language-symbol out) |
|---|
| 51 |
(dolist (get-param (remove "language" (hunchentoot:get-parameters*) |
|---|
| 52 |
:key #'first :test #'equal)) |
|---|
| 53 |
(destructuring-bind (key . value) get-param |
|---|
| 54 |
(write-string "&" out) |
|---|
| 55 |
(write-string key out) |
|---|
| 56 |
(write-string "=" out) |
|---|
| 57 |
(write-string value out)))) |
|---|
| 58 |
(:princ-safe language-name))))) |
|---|
| 59 |
(if (equal (request-language) language-symbol) |
|---|
| 60 |
(html "[" (show-language-link) "]") |
|---|
| 61 |
(html (show-language-link))) |
|---|
| 62 |
(html " ")))))) |
|---|
| 63 |
|
|---|
| 64 |
(defun decode-ismap-query-string () |
|---|
| 65 |
(let ((coord-string (caar (query-params)))) |
|---|
| 66 |
(when (and coord-string (scan #?r"^\d*,\d*$" coord-string)) |
|---|
| 67 |
(mapcar #'parse-integer (split "," coord-string))))) |
|---|
