diff --git a/chapter.lisp b/chapter.lisp
index 2df5a96..afe60b2 100644
--- a/chapter.lisp
+++ b/chapter.lisp
@@ -4,50 +4,30 @@
((%verses :initarg :verses
:reader verses)))
-(defgeneric chapter-to-clog (chapter parent &key translation))
-(defgeneric book/chapter-window (canvas title))
+(defgeneric chapter-to-clog (chapter parent))
+(defgeneric book/chapter-window (canvas))
(defgeneric translations-drop-down (div display chapter drop-down))
-(defgeneric display-chapter-or-book (canvas title chapter))
+(defgeneric display-chapter-or-book (canvas chapter))
(defgeneric load-chapter (canvas book chapter))
-(defgeneric load-book (canvas book))
+(defgeneric load-position (canvas pos))
-(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj) &key (translation :mng))
+(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj))
(labels ((verse-to-clog (verse)
-;;; (clog:set-on-click
- (v:verse-to-clog verse parent :translation translation)
-;;; (lambda (obj)
-;;; (declare (ignore obj))
-;;; (v::show-notes verse parent)))
- ))
+ (create-p parent
+ :content (concatenate 'string
+ (if (string= (v:vnumber verse) "1")
+ (format nil "~A ~A:
"
+ (v:bname verse)
+ (v:chapter verse))
+ "")
+ (v:verse-to-string verse)))))
(mapcar #'verse-to-clog (verses chapter))))
-(defmethod book/chapter-window (canvas (title string))
- (let* ((win (window-content
- (create-gui-window canvas
- :title title
- :height 400
- :width 500)))
- (mbar (create-gui-menu-bar win))
- (drop-down (create-gui-menu-drop-down mbar :content "Translations")))
- (values (create-div win)
- drop-down)))
+(defmethod book/chapter-window (canvas)
+ (create-div (create-web-content (create-web-main canvas))))
-(defmethod translations-drop-down ((div clog:clog-div) display (chapter chapter) drop-down)
- (mapcar
- (lambda (translation)
- (labels ((callback (obj)
- (declare (ignore obj))
- (d:update-bible (third translation))))
- (create-gui-menu-item drop-down
- :content (first translation)
- :on-click #'callback)))
- d:*translations*))
-
-(defmethod display-chapter-or-book (canvas (title string) (chapter chapter))
- (multiple-value-bind (div drop-down)
- (book/chapter-window canvas title)
- (let ((display (chapter-to-clog chapter div :translation d:*translation*)))
- (translations-drop-down div display chapter drop-down))))
+(defmethod display-chapter-or-book (canvas (chapter chapter))
+ (chapter-to-clog chapter (book/chapter-window canvas)))
(defmethod load-chapter (canvas (book string) (chapter string))
(let* ((bk (s:find-book d:*bible* book))
@@ -56,24 +36,9 @@
:append (s:find-chapter bk chap))
(s:find-chapter bk chapter))))
(display-chapter-or-book canvas
- (format nil "~A: ~A ~A"
- d:*translation*
- book
- chapter)
(make-instance 'chapter :verses verses))))
-(defmethod load-book ((canvas clog:clog-body) (book string))
- (display-chapter-or-book canvas
- (format nil "~A: ~A"
- d:*translation*
- book)
- (make-instance 'chapter
- :verses (s:find-book d:*bible* book))))
-
(defmethod load-position ((canvas clog:clog-body) (pos string))
(display-chapter-or-book canvas
- (format nil "~A: ~A"
- d:*translation*
- pos)
(make-instance 'chapter
:verses (s:find-verse d:*bible* (s:parse-position pos)))))
diff --git a/clog.lisp b/clog.lisp
index ab75d76..0a7d38b 100644
--- a/clog.lisp
+++ b/clog.lisp
@@ -5,9 +5,8 @@
(defvar *body*)
(defun lift-search-window (body search)
- (let ((result (mapcar #'car (l:lift-search search)))
- (win (create-gui-window body)))
- (create-p (window-content win)
+ (let ((result (mapcar #'car (l:lift-search search))))
+ (create-p body
:content (str:join ", " (if result
result
'("No results"))))))
@@ -15,43 +14,22 @@
(defun ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
-(defun test (canvas)
- (create-gui-window canvas :title "Test"
- :height 400
- :width 300))
-
-(defun test (canvas)
- (let* ((win (window-content
- (create-gui-window canvas :title "Test"
- :height 300
- :width 400)))
- (button (create-button win :content "click me!"))
- (div (create-div win)))
- (create-p div :content "foo")
- (set-on-click button (lambda (obj)
- (declare (ignore obj))
- (format t "Clicked button!")))
- div))
-
(defun search-in-bible (phrase bible canvas)
- (let* ((win (window-content
- (create-gui-window canvas
- :title (format nil "~A: ~A"
- d:*translation*
- phrase)
- :height 400
- :width 500)))
- (lift-search (create-button win :content "Lift Search"))
- (div (create-div win))
- (results (s:find-in-bible bible phrase)))
- (set-on-click lift-search (lambda (obj)
- (declare (ignore obj))
- (lift-search-window canvas results)))
- (create-p div :content (ergebnis/se
- (length results)))
+ (let ((content (create-web-content canvas))
+ (results (s:find-in-bible bible phrase)))
+ (create-p content :content (format nil "~A" (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
- (v:verse-to-clog verse div :translation d:*translation*)
+ (create-p content
+ :content (format nil "~A ~A:
~A"
+ (v:bname verse)
+ (v:chapter verse)
+ (v:verse-to-string verse)))
(lambda (obj)
(declare (ignore obj))
(ch:load-chapter canvas
@@ -59,108 +37,63 @@
(v:chapter verse)))))
results)))
-(defun %bible-book-or-chapter (bible book chapter)
- (if (string= book "")
- bible
- (let ((book (s:find-book bible book)))
- (if (string= chapter "")
- book
- (s:find-chapter book chapter)))))
-
-(defun search-with-chapter (window data)
- (let ((book (cadr (assoc "book" data :test #'string=)))
- (chapter (cadr (assoc "chapter" data :test #'string=)))
- (phrase (cadr (assoc "phrase" data :test #'string=))))
- (search-in-bible phrase
- (%bible-book-or-chapter d:*bible* book chapter)
- window)))
-
-(defun searcher (window)
- (lambda (obj)
- (declare (ignore obj))
- (form-dialog window "What do you want to search?"
- '(("Phrase" "phrase" :text)
- ("Book" "book" :text)
- ("Chapter" "chapter" :text))
- (lambda (data)
- (search-with-chapter window data))
- :title "Search a phrase")))
-
(defun reload (window)
(lambda (obj)
(declare (ignore obj))
- (form-dialog 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 (cadar results))
- :title "Load a Bible"))))
+ (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 (window body)
+(defun get-chapter (body)
(lambda (obj)
(declare (ignore obj))
- (form-dialog window "Which passage do you want?"
+ (clog-web-form body "Which passage do you want?"
'(("" "pos" :text))
- (load-book-or-chapter body)
- :title "Load a Passage")))
-
-(defun setup-window (body)
- (let ((window (create-gui-window body :title "background"
- :hidden t)))
- (window-normalize window)
- (window-center window)
- window))
-
-(defun setup-menu-bar (body window)
- (let* ((mbar (create-gui-menu-bar body))
- (drop-down (create-gui-menu-drop-down mbar
- :content "Options")))
- (create-gui-menu-full-screen mbar)
- (create-gui-menu-item drop-down
- :content "Search"
- :on-click (searcher window))
- (create-gui-menu-item drop-down
- :content "Get Chapter"
- :on-click (get-chapter window body))
- (create-gui-menu-item drop-down
- :content "Load Bible"
- :on-click (reload window))
- (create-gui-menu-item mbar
- :content "Close all windows"
- :on-click (lambda (obj)
- (declare (ignore obj))
- (loop :for win = (current-window body)
- :if (or (null win)
- (string= (window-title win)
- "background"))
- :do (return)
- :do (window-close win))))
- (create-gui-menu-item mbar
- :content "Save notes"
- :on-click (lambda (obj)
- (declare (ignore obj))
- (d:persist)))
- (create-gui-menu-item mbar
- :content "Load notes"
- :on-click (lambda (obj)
- (declare (ignore obj))
- (d:load-bibles)))))
+ (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-gui-initialize body)
- (setup-menu-bar body (setup-window body)))
+ (clog-web-initialize body)
+ (setup-menu-bar body))
diff --git a/data.lisp b/data.lisp
index d4aee1f..555a010 100644
--- a/data.lisp
+++ b/data.lisp
@@ -18,122 +18,8 @@
(uiop:read-file-lines
(uiop:native-namestring (concatenate 'string "~/.bible/" filename ".tsv")))))
-(defun load-bible (filename)
- (v:from-sexp
- (read-from-string
- (uiop:read-file-string (uiop:native-namestring filename)))))
-
-(defvar *translation* :mng)
-(defvar *bible* nil)
-
-(defun load-bibles ()
- (ensure-directories-exist (uiop:native-namestring "~/.bible/"))
- (if (uiop:file-exists-p (uiop:native-namestring "~/.bible/bible.sexp"))
- (setf *bible* (load-bible "~/.bible/bible.sexp"))
- (setf *bible*
- (load-bible
- (asdf:system-relative-pathname :cl-bible
- "resources/bible.sexp")))))
-
-(load-bibles)
+(defvar *translation* :vul)
+(defvar *bible* (read-bible-from-tsv "vul"))
(defun update-bible (translation)
- (setf *translation* (intern translation :keyword))
(setf *bible* (read-bible-from-tsv (string-downcase translation))))
-
-(defun persist-bible (bible filename filepath)
- (with-open-file (file (uiop:native-namestring (concatenate 'string filepath filename ".sexp"))
- :direction :output
- :if-exists :overwrite
- :if-does-not-exist :create)
- (print (v:to-sexp bible) file)))
-
-(defun persist (&optional (filepath "~/.bible/"))
- (ensure-directories-exist (uiop:native-namestring filepath))
- (persist-bible *bible* "bible" filepath))
-
-(defvar mapping '(("Genesis" . "Genesis")
- ("Exodus" . "Exodus")
- ("Levitikus" . "Levitikus")
- ("Numeri" . "Numeri")
- ("Deuteronomium" . "Deuteronomium")
- ("Josua" . "Josua")
- ("Richter" . "Richter")
- ("Rut" . "Ruth")
- ("1 Samuel" . "1 Samuel")
- ("2 Samuel" . "2 Samuel")
- ("1 Könige" . "1 Könige")
- ("2 Könige" . "2 Könige")
- ("1 Chronik" . "1 Chronika")
- ("2 Chronik" . "2 Chronika")
- ("Esra" . "Esra")
- ("Nehemia" . "Nehemia")
- ("Ester" . "Esther")
- ("Ijob" . "Hiob")
- ("Psalmen" . "Psalmen")
- ("Sprüche" . "Sprüche")
- ("Kohelet" . "Kohelet")
- ("Hohelied" . "Hohelied")
- ("Jesaja" . "Jesaja")
- ("Jeremia" . "Jeremia")
- ("Klagelieder" . "Klagelieder")
- ("Ezechiel" . "Hesekiel")
- ("Daniel" . "Daniel")
- ("Hosea" . "Hosea")
- ("Joël" . "Joel")
- ("Amos" . "Amos")
- ("Obadja" . "Obadja")
- ("Jona" . "Jona")
- ("Micha" . "Micha")
- ("Nahum" . "Nahum")
- ("Habakuk" . "Habakuk")
- ("Zephanja" . "Zephania")
- ("Haggai" . "Haggai")
- ("Sacharja" . "Sacharia")
- ("Maleachi" . "Maleachi")
- ("Matthäus" . "Matthäus")
- ("Markus" . "Markus")
- ("Lukas" . "Lukas")
- ("Johannes" . "Johannes")
- ("Apostelgeschichte" . "Apostelgeschichte")
- ("Römer" . "Römer")
- ("1 Korinther" . "1 Korinther")
- ("2 Korinther" . "2 Korinther")
- ("Galater" . "Galater")
- ("Epheser" . "Epheser")
- ("Philipper" . "Philipper")
- ("Kolosser" . "Kolosser")
- ("1 Thessalonicher" . "1 Thessalonicher")
- ("2 Thessalonicher" . "2 Thessalonicher")
- ("1 Timotheus" . "1 Timotheus")
- ("2 Timotheus" . "2 Timotheus")
- ("Titus" . "Titus")
- ("Philemon" . "Philemon")
- ("Hebräer" . "Hebräer")
- ("Jakobus" . "Jakobus")
- ("1 Petrus" . "1 Petrus")
- ("2 Petrus" . "2 Petrus")
- ("1 Johannes" . "1 Johannes")
- ("2 Johannes" . "2 Johannes")
- ("3 Johannes" . "3 Johannes")
- ("Judas" . "Judas")
- ("Offenbarung" . "Offenbarung")
- ("Judit" . "Judit")
- ("Weisheit" . "Weisheit")
- ("Tobit" . "Tobit")
- ("Sirach" . "Sirach")
- ("Baruch" . "Baruch")
- ("1 Makkabäer" . "1 Makkabäer")
- ("2 Makkabäer" . "2 Makkabäer")
- ("xDaniel" . "xDaniel")
- ("Manasse" . "Manasse")
- ("xEster" . "xEster")))
-
-(defun add-bible (bible new mapping)
- (mapc (lambda (map)
- (mapc (lambda (old new)
- (nconc (v:translations new)
- (v::translations old)))
- (cl-bible.search:find-book bible (car map))
- (cl-bible.search:find-book new (cdr map))))
- mapping))
diff --git a/lift-search.lisp b/lift-search.lisp
index 274d090..4ffecf6 100644
--- a/lift-search.lisp
+++ b/lift-search.lisp
@@ -20,7 +20,7 @@
(funcall f1 (apply f2 args))))
(defun lift-search (search-result)
- (comb (diff-verses (mapcar (compose #'normalize-string #'v:get-text)
+ (comb (diff-verses (mapcar (compose #'normalize-string #'v:text)
search-result))
(length search-result)))
diff --git a/package.lisp b/package.lisp
index 7509850..05ca63d 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,8 +1,8 @@
-;;;; package.lisp
+;;; package.lisp
(defpackage #:cl-bible.verse
(:use #:cl)
- (:export verse-to-clog
+ (:export verse-to-string
string-to-verse
to-sexp
from-sexp
@@ -43,7 +43,7 @@
(:export lift-search))
(defpackage #:cl-bible.chapter
- (:use #:cl #:clog #:clog-gui)
+ (:use #:cl #:clog #:clog-gui #:clog-web)
(:local-nicknames (#:d #:cl-bible.data)
(#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
@@ -52,7 +52,7 @@
load-position))
(defpackage #:cl-bible.clog
- (:use #:cl #:clog #:clog-gui)
+ (:use #:cl #:clog #:clog-gui #:clog-web)
(:local-nicknames (#:l #:cl-bible.lift-search)
(#:d #:cl-bible.data)
(#:s #:cl-bible.search)
diff --git a/search.lisp b/search.lisp
index 77fa1f6..2f374c9 100644
--- a/search.lisp
+++ b/search.lisp
@@ -3,7 +3,7 @@
(in-package #:cl-bible.search)
(defun find-in-bible (bible phrase)
- (remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
+ (remove-if-not (lambda (verse) (search phrase (v:text verse)))
bible))
(defmethod find-book (bible book)
@@ -15,7 +15,7 @@
(defmethod find-verse (chapter verse)
(remove-if-not (lambda (v) (string= verse (v:vnumber v))) chapter))
-(defclass position ()
+(defclass pos ()
((book :initarg :book
:reader book)
(start :initarg :start
@@ -32,19 +32,33 @@
:initform nil
:reader verse)))
-(defun parse-position (position)
- (if (find #\space position)
- (destructuring-bind (book rest)
- (uiop:split-string position :separator '(#\space))
- (if (find #\- rest)
- (destructuring-bind (start end)
- (uiop:split-string rest :separator '(#\-))
- (make-instance 'position :book book
- :start (parse-verse-pos start)
- :end (parse-verse-pos end)))
- (make-instance 'position :book book
- :start (parse-verse-pos rest))))
- (make-instance 'position :book position)))
+(defmethod parse-position :around ((position string))
+ (cond ((string= position "") nil)
+ ((find #\space position) (call-next-method))
+ (t (make-instance 'pos :book position))))
+
+(defmethod parse-position ((position string))
+ (let* ((first-split (uiop:split-string position :separator '(#\space)))
+ (split (if (ignore-errors (parse-integer (first first-split)))
+ (cons (format nil "~A ~A" (first first-split)
+ (second first-split))
+ (cddr first-split))
+ first-split)))
+ (if (cdr split)
+ (parse-position split)
+ (make-instance 'pos :book (first split)))))
+
+(defmethod parse-position ((position cons))
+ (destructuring-bind (book rest)
+ position
+ (if (find #\- rest)
+ (destructuring-bind (start end)
+ (uiop:split-string rest :separator '(#\-))
+ (make-instance 'pos :book book
+ :start (parse-verse-pos start)
+ :end (parse-verse-pos end)))
+ (make-instance 'pos :book book
+ :start (parse-verse-pos rest)))))
(defun parse-verse-pos (verse-pos)
(if (find #\, verse-pos)
@@ -54,16 +68,16 @@
:verse (parse-integer verse)))
(make-instance 'verse-pos :chapter (parse-integer verse-pos))))
-(defmethod bookp ((pos position))
+(defmethod bookp ((pos pos))
(if (start pos) nil t))
-(defmethod rangep ((pos position))
+(defmethod rangep ((pos pos))
(if (end pos) t nil))
(defmethod versep ((pos verse-pos))
(if (verse pos) t nil))
-(defmethod versep ((pos position))
+(defmethod versep ((pos pos))
(versep (start pos)))
(defun find-position (bible position)
@@ -86,10 +100,10 @@ the requested verse/s"
(find-verse chapter (format nil "~A" (verse start))))
chapter)))))
-(defmethod find-book (bible (pos position))
+(defmethod find-book (bible (pos pos))
(find-book bible (book pos)))
-(defmethod find-chapter (bible (pos position))
+(defmethod find-chapter (bible (pos pos))
(let ((book (find-book bible pos)))
(if (bookp pos)
book
@@ -101,7 +115,7 @@ the requested verse/s"
:append (find-chapter book (format nil "~A" chapter)))
(find-chapter book (format nil "~A" (chapter start))))))))
-(defmethod find-verse (bible (pos position))
+(defmethod find-verse (bible (pos pos))
(let ((chapter (find-chapter bible pos)))
(if (bookp pos)
chapter
diff --git a/verse.lisp b/verse.lisp
index 8d762f5..2f83dd7 100644
--- a/verse.lisp
+++ b/verse.lisp
@@ -21,14 +21,13 @@
:accessor notes)))
(defgeneric string-to-verse (string))
-(defgeneric verse-to-string (verse &key separator translation))
+(defgeneric verse-to-string (verse))
(defgeneric verse-to-latex (verse &key translation port))
(defgeneric get-text (verse))
(defgeneric %format-notes (notes))
(defgeneric %create-notes-window (verse parent))
(defgeneric show-notes (verse parent))
(defgeneric add-notes (verse parent))
-(defgeneric verse-to-clog (verse parent &key translation))
(defgeneric to-sexp (verse))
(defgeneric verse-from-sexp (sexp))
(defgeneric from-sexp (bible))
@@ -44,26 +43,16 @@
:number (fifth verse)
:text (sixth verse))))
-(defmethod verse-to-string ((verse cons) &key (separator " ") translation)
- (declare (ignore translation))
+(defmethod verse-to-string ((verse cons))
(format nil "~A ~A:~A~A~A" (cadr verse)
(nth 3 verse)
(nth 4 verse)
- separator
(nth 5 verse)))
-(defmethod verse-to-string ((verse verse) &key (separator "
") (translation :elb1871))
- (concatenate 'string
- (when (string= (vnumber verse) "1")
- (format nil "~A ~A~A"
- (bname verse)
- (chapter verse)
- separator))
- (format nil "~A ~A"
- (vnumber verse)
- (if (translations verse)
- (cdr (assoc translation (translations verse)))
- (text verse)))))
+(defmethod verse-to-string ((verse verse))
+ (format nil "~A ~A"
+ (vnumber verse)
+ (text verse)))
(defmethod verse-to-latex ((verse verse) &key translation (port t))
(declare (ignore translation))
@@ -75,13 +64,6 @@
(translations verse)))
'(:mng :luth1545 :luth1912 :sch1951 :elb1871 :neue))))
-(defmethod get-text ((verse verse))
- (let ((translations (translations verse)))
- (if translations
- (cdr (assoc cl-bible.data:*translation*
- translations))
- (text verse))))
-
(defmethod %format-notes ((notes cons))
(format nil "~{~A~^
~}" notes))
@@ -124,10 +106,6 @@
(declare (ignore obj))
(push (clog:value text) (notes verse))))))
-(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
- (clog:create-p parent :content (verse-to-string verse :translation translation)))
-
-
(defmethod to-sexp ((verse verse))
(list (bname verse)
(bsname verse)