|
|
|
;;;; cl-bible.lisp
|
|
|
|
|
|
|
|
(in-package #:cl-bible.clog)
|
|
|
|
|
|
|
|
(defvar *body*)
|
|
|
|
|
|
|
|
(defun lift-search-window (body search)
|
|
|
|
(let ((result (mapcar #'car (l:lift-search search))))
|
|
|
|
(create-p body
|
|
|
|
:content (str:join ", " (if result
|
|
|
|
result
|
|
|
|
'("No results"))))))
|
|
|
|
|
|
|
|
(defun ergebnis/se (n)
|
|
|
|
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
|
|
|
|
|
|
|
|
(defun search-in-bible (phrase bible canvas)
|
|
|
|
(let ((content (create-web-content canvas))
|
|
|
|
(results (s:find-in-bible bible phrase)))
|
|
|
|
(create-p content :content (format nil "<b>~A</b>" (ergebnis/se (length results))))
|
|
|
|
(let ((lift-search (create-web-panel content)))
|
|
|
|
(set-on-click (create-button lift-search :content "Lift Search")
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(lift-search-window lift-search results))))
|
|
|
|
(mapc (lambda (verse)
|
|
|
|
(clog:set-on-click
|
|
|
|
(create-p content
|
|
|
|
:content (format nil "<b>~A ~A:</b><br />~A"
|
|
|
|
(v:bname verse)
|
|
|
|
(v:chapter verse)
|
|
|
|
(v:verse-to-string verse)))
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(ch:load-chapter canvas
|
|
|
|
(v:bname verse)
|
|
|
|
(v:chapter verse)))))
|
|
|
|
results)))
|
|
|
|
|
|
|
|
(defun reload (window)
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(let ((dialog (clog-web-form window "Which bible do you want?"
|
|
|
|
'(("Bible" "bible" :select (("Menge" :mng)
|
|
|
|
("King James Version" :kjv)
|
|
|
|
("Vulgata" :vul)
|
|
|
|
("Greek Bible" :grb)
|
|
|
|
("Elberfelder Übersetzung 1871" :elb1871)
|
|
|
|
("NEÜ" :neue)
|
|
|
|
("Luther 1545" :luth1545)
|
|
|
|
("Luther 1912" :luth1912)
|
|
|
|
("Schlachter 1951" :sch1951)
|
|
|
|
("Ukrainische Version" :ukr))))
|
|
|
|
(lambda (results)
|
|
|
|
(d:update-bible (form-result results "bible")))))))))
|
|
|
|
|
|
|
|
(defun load-book-or-chapter (canvas)
|
|
|
|
(lambda (data)
|
|
|
|
(ch:load-position canvas
|
|
|
|
(second (assoc "pos" data :test #'string=)))))
|
|
|
|
|
|
|
|
(defun get-chapter (body)
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(clog-web-form body "Which passage do you want?"
|
|
|
|
'(("" "pos" :text))
|
|
|
|
(load-book-or-chapter body))))
|
|
|
|
|
|
|
|
(defun setup-menu-bar (body)
|
|
|
|
(let* ((form-space (create-web-content body))
|
|
|
|
(form2 (create-form form-space))
|
|
|
|
(bible (create-select form2 :label (create-label form2 :content "Choose your translation: ")))
|
|
|
|
(_ (create-br form-space))
|
|
|
|
(form1 (create-form form-space))
|
|
|
|
(passage (create-form-element form1 :search :class "w3-input w3-border"))
|
|
|
|
(__ (create-br form-space))
|
|
|
|
(form3 (create-form form-space))
|
|
|
|
(search (create-form-element form3 :search :class "w3-input w3-border")))
|
|
|
|
(declare (ignore _ __))
|
|
|
|
(add-select-options bible '("elb1871" "mng" "neue" "luth1545" "luth1912" "sch1951" "kjv" "vul" "grb" "ukr"))
|
|
|
|
(set-on-change bible (lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(d:update-bible (value bible))))
|
|
|
|
(create-form-element form1 :submit :value "Get passage")
|
|
|
|
(set-on-submit form1
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(ch:load-position body (value passage))))
|
|
|
|
(create-form-element form3 :submit :value "Search phrase")
|
|
|
|
(set-on-submit form3
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(search-in-bible (value search) d:*bible* body)))))
|
|
|
|
|
|
|
|
(defun on-new-window (body)
|
|
|
|
(setf *body* body)
|
|
|
|
(setf (title (html-document body)) "Bible")
|
|
|
|
(clog-web-initialize body)
|
|
|
|
(setup-menu-bar body))
|