Skip to content

Latest commit

 

History

History
668 lines (575 loc) · 27 KB

bricks.org

File metadata and controls

668 lines (575 loc) · 27 KB

Компоненты для создания интерфейса

В этом файле содержатся компоненты, используемые модулями для построения веб-интерфейса. При изменении дизайна в них могут вноситься изменения, но общую целостность и соглашения о вызовах следует соблюдать.

Эти компоненты - первые кандидаты на вынесение в отдельный пакет для удобного подключения к различным модулям, входящим в состав системы.

Все компоненты реализованы макросами используют ps-html из библиотеки parenscript в качестве оконечного генератора кода

;;;; <<copyright>>

;;;; bricks.lisp

<<input>>
<<textarea>>
<<select>>
<<fieldset>>
<<submit>>
<<form>>
<<teaser>>
<<overlay>>
<<heading>>
<<breadcrumb>>
<<menu>>
<<content_box>>
<<system-msg>>
<<standard-page>>
Copyright © 2014-2015 Glukhov Mikhail. All rights reserved.
Licensed under the GNU AGPLv3

Input

Поле ввода внутри формы представляет собой div-контейнер, содержащий label, input и (опционально) информацию валидатора. Также поле может быть обязательным для заполнения (required).

Наша задача сформировать контейнер и его содержимое, дополняя описание классов, если оно передано и устанавливая другие параметры по умолчанию, если они не переданы.

Мы также оставляем возможность передать некоторые дополнительные параметры input-у

(in-package #:moto)

(defmacro input ((name title &rest rest &key container-class class required type value &allow-other-keys) &body nobody)
  (let ((result-container-class "input-container")
        (label `(:label :for ,name)))
    (when container-class
      (setf result-container-class (concatenate 'string result-container-class " " container-class)))
    (when required
      (setf label (append label `(:required "required"))))
    (let ((result-class "form-element input-text"))
      (when required
        (setf result-class (concatenate 'string result-class " required")))
      (when class
        (setf result-class (concatenate 'string result-class " " class)))
      (unless type
        (setf type "text"))
      (unless value
        (setf value ""))
      (remf rest :container-class)
      (remf rest :class)
      (remf rest :required)
      (remf rest :type)
      (remf rest :value)
      (let ((input `(:input :type ,type :name ,name :id ,name :class ,result-class :value ,value)))
        (unless (null rest)
          (setf input (append input rest)))
        (let ((input-container `((:div :class ,result-container-class)
                                 (,label ,title)
                                 ((:div :class "input-bg")
                                  (,input)))))
          `(ps-html ,input-container))))))

(defmacro textarea ((name title &rest rest &key container-class class required type value &allow-other-keys) &body nobody)
  (let ((result-container-class "input-container")
        (label `(:label :for ,name)))
    (when container-class
      (setf result-container-class (concatenate 'string result-container-class " " container-class)))
    (when required
      (setf label (append label `(:required "required"))))
    (let ((result-class "form-element textarea-text"))
      (when required
        (setf result-class (concatenate 'string result-class " required")))
      (when class
        (setf result-class (concatenate 'string result-class " " class)))
      (unless type
        (setf type "text"))
      (unless value
        (setf value ""))
      (remf rest :container-class)
      (remf rest :class)
      (remf rest :required)
      (remf rest :type)
      (remf rest :value)
      (let ((textarea `(:textarea :type ,type :name ,name :id ,name :class ,result-class :value ,value)))
        (unless (null rest)
          (setf textarea (append textarea rest)))
        (let ((textarea-container `((:div :class ,result-container-class)
                                 (,label ,title)
                                 ((:div :class "input-bg")
                                  (,textarea)))))
          `(ps-html ,textarea-container))))))

;; (macroexpand-1 '(input ("mobile" "Мобильный телефон" :maxlength "15" :container-class "input-container--1-2 even")))

;; (macroexpand-1 '(input ("email" "Email" :required t :class "my-super-class" :type "email" :maxlength "50")))

;; (input ("email" "Email" :required t :class "my-super-class" :type "email" :maxlength "50" ))

Textarea

Аналогично input-у

(in-package #:moto)

(defun textarea (name title content)
  `("div" (("class" "input-container"))
          ("label" (("for" ,name)) ,title)
          ("div" (("CLASS" "input-bg"))
                 ("textarea" (("type" "text")
                              ("name" ,name)
                              ("id" ,name)
                              ("class" "form-element textarea-text"))
                             ,content))))

;; (textarea "notes" "Заметки" "aaaa")

;; => ("div" (("class" "input-container")) ("label" (("for" "notes")) "Заметки")
;;           ("div" (("CLASS" "input-bg"))
;;                  ("textarea"
;;                   (("type" "text") ("name" "notes") ("id" "notes")
;;                    ("class" "form-element textarea-text"))
;;                   "aaaa")))

Селектор

(in-package #:moto)

(defmacro select ((name title &rest rest &key container-class class required default &allow-other-keys) &body options)
  (let ((result-container-class "input-container")
        (label `(:label :for ,name)))
    (when container-class
      (setf result-container-class (concatenate 'string result-container-class " " container-class)))
    (when required
      (setf label (append label `(:required "required"))))
    (let ((result-class "form-element"))
      (when required
        (setf result-class (concatenate 'string result-class " required")))
      (remf rest :container-class)
      (remf rest :class)
      (remf rest :required)
      (when default
        (setf default (eval default)))
      (remf rest :default)
      (let ((select `(:select :name ,name :id ,name :class ,result-class)))
        (unless (null rest)
          (setf select (append select rest)))
        (let ((select-container `((:div :class ,result-container-class)
                                  (,label ,title)
                                  (,select ,@(loop :for (value . label) :in (car options) :collect
                                                (if (equal default value)
                                                    `((:option :value ,value :selected "selected") ,label)
                                                    `((:option :value ,value) ,label)))))))
          `(ps-html ,select-container))))))

;; (macroexpand-1 '(select ("sex" "Пол" :default (test "sex"))
;;                  (("" . "Выбрать пол")
;;                   ("male" . "Мужской")
;;                   ("female" . "Женский"))))
;; (select ("sex" "Пол" :default (test "sex"))
;;   (("" . "Выбрать пол")
;;    ("male" . "Мужской")
;;    ("female" . "Женский")))

Набор полей формы

Оборачивает переданный ему список в div-контейнер и fileset

(in-package #:moto)

(defun fieldset (legend &rest content)
  `("fieldset"
    ()
    ("legend" () ,legend)
    ,@content))

;; `(,(fieldset "Заметки"
;;              `("p" () "Lorem ipsum 1")
;;              `("p" () "Lorem ipsum 2")))

;; => (("fieldset" ()
;;      ("legend" () "Заметки")
;;      ("p" () "Lorem ipsum 1")
;;      ("p" () "Lorem ipsum 2")))


;; (tree-to-html
;;  `(,(fieldset "Заметки"
;;               `("p" () "Lorem ipsum 1")
;;               `("p" () "Lorem ipsum 2"))))

;; => "<fieldset>
;;    <legend>
;;       Заметки
;;    </legend>
;;    <p>
;;       Lorem ipsum 1
;;    </p>
;;    <p>
;;       Lorem ipsum 2
;;    </p>
;; </fieldset>
;; "

Кнопка отправки формы

(in-package #:moto)

(defmacro submit (title &rest rest &key class container-class &allow-other-keys)
  (let ((result-container-class "")
        (result-class "button"))
    (when container-class
      (setf result-container-class
            (concatenate 'string result-container-class " " container-class)))
    (remf rest :container-class)
    (when class
      (setf result-class
            (concatenate 'string result-class " " class)))
    (remf rest :class)
    (let ((rested (loop :for key :in rest :by #'cddr :collect
                     `(list ',(list (string-downcase (symbol-name key))
                                    (getf rest key))))))
      ``("div" (("class" ,,result-container-class))
               ("button" (("type" "submit")
                          ("class" ,,result-class)
                          ,@,@rested
                          )
                         ,,title)))))

;; (macroexpand-1 '(submit "Зарегистрироваться" :onclick "alert(1);" :ondblclick "alert(2);"))

;; => (LIST (QUOTE "div")
;;          (LIST
;;           (LIST
;;            (QUOTE "class") ""))
;;          (LIST
;;           (QUOTE "button")
;;           (LIST*
;;            (QUOTE ("type" "submit"))
;;            (LIST
;;             (QUOTE "class") "button")
;;            (APPEND
;;             (LIST '("onclick" "alert(1);"))
;;             (LIST '("ondblclick" "alert(2);"))))
;;           "Зарегистрироваться")), T

;; (submit "Зарегистрироваться" :onclick "alert(1);" :ondblclick "alert(2);")

;; => ("div" (("class" ""))
;;           ("button"
;;            (("type" "submit") ("class" "button") ("onclick" "alert(1);")
;;             ("ondblclick" "alert(2);"))
;;            "Зарегистрироваться"))

;; (tree-to-html
;;  `(,(submit "Зарегистрироваться" :onclick "alert(1);" :ondblclick "alert(2);")))

;; =>
;; "
;; <div class=\"\">
;;    <button type=\"submit\" class=\"button\" onclick=\"alert(1);\" ondblclick=\"alert(2);\">
;;       Зарегистрироваться
;;    </button>
;; </div>
;; "

Форма

(in-package #:moto)

(defmacro form ((name title &rest rest &key action method class &allow-other-keys) &body body)
  (let ((result-class ""))
    (unless action (setf action "#"))
    (unless method (setf method "POST"))
    (when class
      (setf result-class (concatenate 'string result-class " " class)))
    ;; (remf rest :title)
    (remf rest :action)
    (remf rest :method)
    (remf rest :class)
    (setf rest (loop :for key :in rest :by #'cddr :collect
                  `(list ',(string-downcase (symbol-name key))
                         ,(getf rest key))))
    ``("form" (("action" ,,action)
               ("method" ,,method)
               ("id" ,,name)
               ("class" ,,result-class)
               ,,@rest)
              ("input" (("type" "hidden")
                        ("name" ,,(format nil "CSRF-~A" name) :value "todo")))
              ,,@body)))

;; (tree-to-html
;;  `(,(form ("chvacstateform" "" :alfa "beta" :gamma "teta")
;;           `("p" (("class" "b")) "aaa"))))

;; =>
;; "<form action=\"#\" method=\"POST\" id=\"chvacstateform\" class=\"\" alfa=\"beta\" gamma=\"teta\">
;;    <input type=\"hidden\" name=\"CSRF-chvacstateform\">
;;    </input>
;;    <p class=\"b\">
;;       aaa
;;    </p>
;; </form>
;; "

Тизеры

(in-package #:moto)

(defmacro teaser ((&rest rest &key class header &allow-other-keys) &body contents)
  (let ((result-class "teaser-box")
        (inner '((:div :class "inner"))))
    (when class
      (setf result-class (concatenate 'string result-class " " class)))
    (when header
      (setf inner (append inner `(((:div :class "center") ,header)))))
    (setf inner (append inner `(((:p) ,@contents))))
    (remf rest :class)
    (remf rest :header)
    (let ((teaser-box `(:div :class ,result-class)))
      (setf teaser-box (append teaser-box rest))
      `(ps-html
        (,teaser-box ,inner)))))

(macroexpand-1 '(teaser (:header ((:h2 :class "teaser-box--title") "Безопасность данных"))
                 "Адрес электронной почты, телефон и другие
                 данные нигде не показываеются на сайте -
                 мы используем их только для восстановления
                 доступа к аккаунту."
                 ))

;; (macroexpand-1 '(teaser (:header ((:img :src "https://www.louis.de/content/application/language/de_DE/images/tipp.png" :alt "Tip") "Безопасность данных"))
;;                  "Пароль к аккаунту храниться в
;;                  зашифрованной форме - даже оператор сайта не
;;                  может прочитать его"
;;                  ))

;; (macroexpand-1 '(teaser (:class "add" :zzz "zzz")
;;                  "Пароль к аккаунту храниться в
;;                  зашифрованной форме - даже оператор сайта не
;;                  может прочитать его"
;;                  ))

  ;; <div class="content-box size-1-5">
  ;;     <div class="teaser-box">
  ;;         <div class="inner">
  ;;             <div class="center">
  ;;                 <h2 class="teaser-box--title">Безопасность данных</h2>
  ;;             </div>
  ;;             <p>
  ;;                 Адрес электронной почты, телефон и другие
  ;;                 данные нигде не показываеются на сайте -
  ;;                 мы используем их только для восстановления
  ;;                 доступа к аккаунту.
  ;;             </p>
  ;;         </div>
  ;;     </div>
  ;;     <div class="teaser-box text-container">
  ;;         <div class="inner">
  ;;             <div class="center">
  ;;                 <img src="https://www.louis.de/content/application/language/de_DE/images/tipp.png" alt="Tip" />
  ;;             </div>
  ;;             <p>Пароль к аккаунту храниться в
  ;;                 зашифрованной форме - даже оператор сайта не
  ;;                 может прочитать его</p>
  ;;         </div>
  ;;     </div>

;; (ps-html
;;  ((:div :class "content-box size-1-5")
;;   (teaser (:header ((:h2 :class "teaser-box--title") "Безопасность данных"))
;;     "Адрес электронной почты, телефон и другие данные нигде не показываеются на сайте - мы используем их только для восстановления доступа к аккаунту."
;;     )
;;   (teaser (:class "text-container" :header ((:img :src "https://www.louis.de/content/application/language/de_DE/images/tipp.png" :alt "Tip")))
;;     "Пароль к аккаунту храниться в зашифрованной форме - даже оператор сайта не может прочитать его"
;;     )
;;   (teaser (:class "text-container" :header ((:img :src "https://www.louis.de/content/application/language/de_DE/images/tipp.png" :alt "Tip")))
;;     "Все данные шифруются с использованием <a href=\"#dataprivacy-overlay\" class=\"js__openOverlay\">SSL</a>."
;;     )
;;   (teaser (:class "text-container" :header ((:img :src "https://www.louis.de/content/application/language/de_DE/images/tipp.png" :alt "Tip")))
;;     "Безопасный пароль должен состоять не менее чем из 8 символов и включать в себя цифры или другие специальные символы"
;;     )))

Всплывающие окна

(in-package #:moto)

(defmacro overlay ((header &rest rest &key container-class class &allow-other-keys) &body contents)
  (let ((result-container-class "overlay")
        (result-class "text-container"))
    (when container-class
      (setf result-container-class (concatenate 'string result-container-class " " container-class)))
    (remf rest :container-class)
    (remf rest :class)
    (let ((container `(:div :class ,result-container-class)))
      (setf container (append container rest))
      `(ps-html
        (,container
          ((:a :class "action-icon action-icon--close" :href "#") "Close")
          ,header
          ((:div :class "text-container") ,@contents)
          )))))

;; (macroexpand-1 '(overlay (((:h3 :class "overlay__title") "Information on SSL") :container-class "dataprivacy-overlay" :zzz "zzz")
;;                  ((:h4) "How are my order details protected from prying eyes and manipulation by third parties during transmission?")
;;                  ((:p) "Your order data are transmitted to us using 128-bit SSL (Secure Socket Layer) encryption.")))

Заголовок страницы

(in-package #:moto)

(defun heading (name salary-text heading-text)
  `("div" (("class" "heading"))
          ("div" (("class" "heading__inner"))
                 ("div" (("class" "heading__headline"))
                        ("h1" (("class" "heading__headline--h1"))
                              ,name
                              ("span" (("style" "color:red"))
                                      ,salary-text))))
          ("div" (("class" "heading__text"))
                 ,heading-text)))

;; `(,(heading
;;     "Product Owner"
;;     "250000"
;;     `("div" (("class" "vacancy-desc"))
;;             ("p" () "Lorem ipsum 1")
;;             ("p" () "Lorem ipsum 2"))))

;; => (("div" (("class" "heading"))
;;            ("div" (("class" "heading__inner"))
;;                   ("div" (("class" "heading__headline"))
;;                          ("h1" (("class" "heading__headline--h1")) "Product Owner"
;;                                ("span" (("style" "color:red")) "250000"))))
;;            ("div" (("class" "heading__text"))
;;                   ("div" (("class" "vacancy-desc")) ("p" NIL "Lorem ipsum 1")
;;                          ("p" NIL "Lorem ipsum 2")))))

Хлебные крошки

(in-package #:moto)

(defmacro breadcrumb (last &rest prevs)
  (let ((acc nil))
    (loop :for (url . title) :in prevs :do
       (setf acc (append acc `(((:span :itemscope "" :itemtype "http://data-vocabulary.org/Breadcrumb")
                                ((:a :href ,url :itemprop "url")
                                 ((:span :itemprop "title") ,title)))
                               "&nbsp;/&nbsp;"))))
    (setf acc (append acc `(((:span) ,last))))
    `(ps-html ,`((:p :class "breadcrumb")
                 ((:span :class "breadcrumb__title") "Вы тут:")
                 ((:span :class "breadcrumb__content") ,@acc
                  )))))

;; (macroexpand-1 '(breadcrumb "Регистрация нового пользователя" ("/" . "Главная") ("/secondary" . "Второстепенная")))

;; (breadcrumb "Регистрация нового пользователя" ("/" . "Главная") ("/secondary" . "Второстепенная"))

Меню

(in-package #:moto)

(defun menu ()
  (if (null *current-user*)
      (ps-html
       ((:li :class "active")
        ((:a :title "Регистрация" :href "/reg") "Регистрация"))
       ((:li)
        ((:a :title "Логин" :href "/login") "Логин"))
       ((:li)
        ((:a :title "Пользователи" :href "/users") "Пользователи"))
       ((:li)
        ((:a :title "Группы" :href "/groups") "Группы"))
       ((:li)
        ((:a :title "Роли" :href "/roles") "Роли")))
       (ps-html
        ((:li)
         ((:a :title "Пользователи" :href "/users") "Пользователи"))
        ((:li)
         ((:a :title "Группы" :href "/groups") "Группы"))
        ((:li)
         ((:a :title "Роли" :href "/roles") "Роли"))
        ((:li)
         ((:a :title "Профиль" :href (format nil "/user/~A" *current-user*)) "Профиль"))
        ((:li)
         ((:a :title "Сообщения" :href "/im") "Сообщения"))
        ((:li)
         ((:a :title "Задачи" :href "/tasks") "Задачи"))
        ((:li)
         ((:a :title "Выход" :href "/logout") "Выход")))))
  ;; "<a href=\"/load\">Загрузка данных</a>")
  ;; "<a href=\"/\">TODO: Расширенный поиск по ЖК</a>"
  ;; "<a href=\"/cmpxs\">Жилые комплексы</a>"
  ;; "<a href=\"/find\">Простой поиск</a>"

Блок контента

(in-package #:moto)

(defun content-box (&rest content)
  `("div" (("class" "content-box"))
          ,@content))

;; `(,(content-box
;;     `("div" (("class" "vacancy-desc"))
;;             ("p" () "Lorem ipsum 1")
;;             ("p" () "Lorem ipsum 2"))))

;; => (("div" (("class" "content-box"))
;;            ("div" (("class" "vacancy-desc"))
;;                   ("p" NIL "Lorem ipsum 1")
;;                   ("p" NIL "Lorem ipsum 2"))))

;; (tree-to-html
;;  `(,(content-box
;;      `("div" (("class" "vacancy-desc"))
;;              ("p" () "Lorem ipsum 1")
;;              ("p" () "Lorem ipsum 2")))))

;; =>
;; "<div class=\"content-box\">
;;    <div class=\"vacancy-desc\">
;;       <p>
;;          Lorem ipsum 1
;;       </p>
;;       <p>
;;          Lorem ipsum 2
;;       </p>
;;    </div>
;; </div>
;; "

Системное сообщение

(in-package #:moto)

(defmacro system-msg ((msg-type &rest rest &key class &allow-other-keys) &body body)
  "msg-type: sucess | caution | advantage"
  (let ((result-box-class "box system-message"))
    (when class
      (setf result-box-class (concatenate 'string result-box-class " " class)))
    (remf rest :class)
    (let ((box `(:div :class ,result-box-class)))
      (unless (null rest)
        (setf box (append box rest)))
      (let ((result-icon-type (format nil "result-icon result-icon--~A media__item media__item--left" msg-type)))
        `(ps-html (,box ((:span :class ,result-icon-type))
                        ((:div :class "system-message__text-container")
                         ((:div :class "system-message__text") ,@body))
                        ((:span :class "clear"))))))))

;; (macroexpand-1 '(system-msg ("success") "zzz"))
;; (system-msg (success) "zzz")

Обычная страница

(in-package #:moto)

(defmacro standard-page ((&rest rest &key breadcrumb user menu overlay &allow-other-keys) &body body)
  (unless overlay
    (setf overlay ""))
  `(ps-html
    ((:section :class "container")
     ,breadcrumb
     ((:div :class "main hasNavigation")
      ((:div :class "category-nav-container")
       ((:p :class "category-nav-container__headline trail") ,user)
       ((:ul :class "category-nav--lvl0 category-nav") ,menu))
      ((:article :class "content") ,@body)
      ((:div :class "overlay-container popup" :id "dataprivacy-overlay" :data-dontcloseviabg "" :data-mustrevalidate "") ,overlay)
      ((:span :class "clear")))
     ((:div :class "main-ending")
      ((:div :class "last-seen")
       ((:h5) "Items viewed recently")
       ((:p) "You do not have any recently viewed items.")))
     ((:div :class "overlay-bg")))))

(defmacro base-page ((&rest rest &key breadcrumb overlay &allow-other-keys) &body body)
  (unless overlay
    (setf overlay ""))
  `(ps-html
    ((:section :class "container")
     ,breadcrumb
     ((:div :class "main")
      ((:article :class "content") ,@body)
      ((:div :class "overlay-container popup" :id "dataprivacy-overlay" :data-dontcloseviabg "" :data-mustrevalidate "") ,overlay)
      ((:span :class "clear")))
     ((:div :class "main-ending")
      ((:div :class "last-seen")
       ((:h5) "Items viewed recently")
       ((:p) "You do not have any recently viewed items.")))
     ((:div :class "overlay-bg")))))