silasfox/cl-bible
1
0
Fork 0
Code Issues 3 Pull Requests Projects 1 Releases Wiki Activity

Added a lot of bibles.

Browse Source
This commit is contained in:
Silas Vedder 2022-05-16 13:06:32 +02:00
parent 055b2aca8e
commit cdb05b2f04
12 changed files with 868204 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
clog.lisp
View File

@ -24,7 +24,7 @@
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
(v:verse-to-clog verse div))
(v:verse-to-clog verse div :translation d::*translation*))
results)))
(defun searcher (window)
@ -38,11 +38,18 @@
(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"))))
'(("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)
(princ (cadar results))
(d:update-bible (cadar results))
:title "Load a Bible"))))
@ -63,7 +70,7 @@
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(v:verse-to-clog verse div))
(v:verse-to-clog verse div :translation d::*translation*))
(s:find-book d:*bible* book))))
(defun load-chapter (canvas book chapter)
@ -75,7 +82,7 @@
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(v:verse-to-clog verse div))
(v:verse-to-clog verse div :translation d::*translation*))
(s:find-chapter (s:find-book d:*bible* book) chapter))))
(defun get-chapter (window body)

135
data.lisp
View File

@ -2,56 +2,121 @@
(in-package #:cl-bible.data)
(defun init-bible (&optional (bible "mng"))
(mapcar #'v:string-to-verse
(uiop:read-file-lines
(asdf:system-relative-pathname
"cl-bible"
(format nil "resources/~A.tsv" bible)))))
(defun load-bible (filename)
(v:from-sexp
(read-from-string
(uiop:read-file-string (uiop:native-namestring filename)))))
(defvar *mng*)
(defvar *vul*)
(defvar *grb*)
(defvar *kjv*)
(defvar *translation* :mng)
(defvar *bible*)
(defun load-bibles ()
(ensure-directories-exist (uiop:native-namestring "~/.bible/"))
(if (uiop:file-exists-p (uiop:native-namestring "~/.bible/menge.sexp"))
(progn
(setf *mng* (load-bible "~/.bible/menge.sexp"))
(setf *vul* (load-bible "~/.bible/vulgata.sexp"))
(setf *grb* (load-bible "~/.bible/greek.sexp"))
(setf *kjv* (load-bible "~/.bible/kjv.sexp")))
(progn
(setf *mng* (init-bible "mng"))
(setf *kjv* (init-bible "kjv"))
(setf *vul* (init-bible "vul"))
(setf *grb* (init-bible "grb")))))
(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)
(defun update-bible (str)
(let ((bibles `(("mng" . ,*mng*)
("kjv" . ,*kjv*)
("vul" . ,*vul*)
("grb" . ,*grb*))))
(setf *bible* (cdr (assoc str bibles :test #'string=)))))
(defun update-bible (translation)
(setf *translation* (intern translation :keyword)))
(defun persist-bible (bible filename)
(with-open-file (file (uiop:native-namestring (concatenate 'string "~/.bible/" filename ".sexp"))
(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 ()
(let ((bibles (list *mng* *vul* *grb* *kjv*))
(files '("menge" "vulgata" "greek" "kjv")))
(ensure-directories-exist (uiop:native-namestring "~/.bible/"))
(mapcar #'persist-bible bibles files)))
(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 name mapping)
(mapc (lambda (map)
(mapc (lambda (old new)
(push (cons name (v:text new))
(v::translations old)))
(cl-bible.search:find-book bible (car map))
(cl-bible.search:find-book new (cdr map))))
mapping))

4
package.lisp
View File

@ -11,7 +11,8 @@
chapter
vnumber
text
notes))
notes
translations))
(defpackage #:cl-bible.search
(:use #:cl)
@ -32,6 +33,7 @@
(#:v #:cl-bible.verse))
(:export update-bible
*bible*
*translation*
persist
load-bibles))

681326
resources/bible.sexp Normal file
View File

File diff suppressed because it is too large Load Diff

31173
resources/elb1871.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

31170
resources/luth1545.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

31171
resources/luth1912.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

30951
resources/neue.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

31172
resources/sch1951.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

31102
resources/ukr.tsv Normal file
View File

File diff suppressed because it is too large Load Diff

6
search.lisp
View File

@ -3,7 +3,11 @@
(in-package #:cl-bible.search)
(defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase (v:text verse))) bible))
(remove-if-not (lambda (verse) (search phrase
(cdr
(assoc cl-bible.data:*translation*
(v:translations verse)))))
bible))
(defun find-book (bible book)
(remove-if-not (lambda (verse) (search book (v:bname verse))) bible))

27
verse.lisp
View File

@ -13,6 +13,9 @@
:reader vnumber)
(%text :initarg :text
:reader text)
(%translations :initarg :translations
:initform '()
:accessor translations)
(%notes :initarg :notes
:initform '()
:accessor notes)))
@ -28,20 +31,23 @@
:number (nth 4 verse)
:text (nth 5 verse))))
(defgeneric verse-to-string (verse &key separator))
(defmethod verse-to-string (verse &key (separator " "))
(defgeneric verse-to-string (verse &key separator translation))
(defmethod verse-to-string (verse &key (separator " ") translation)
(declare (ignore translation))
(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 "<br/>"))
(defmethod verse-to-string ((verse verse)
&key (separator "<br/>")
(translation :mng))
(format nil "~A ~A:~A~A ~A" (bsname verse)
(chapter verse)
(vnumber verse)
separator
(text verse)))
(cdr (assoc translation (translations verse)))))
(defmethod show-notes ((verse verse) (parent clog:clog-obj))
(let* ((win (clog-gui:create-gui-window parent
@ -73,9 +79,9 @@
(declare (ignore obj))
(push (clog:value text) (notes verse))))))
(defgeneric verse-to-clog (verse parent))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj))
(let* ((verse-string (verse-to-string verse))
(defgeneric verse-to-clog (verse parent &key translation))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
(let* ((verse-string (verse-to-string verse :translation translation))
(display (clog:create-p parent
:content verse-string)))
(clog:set-on-click display
@ -89,7 +95,7 @@
(bsname verse)
(chapter verse)
(vnumber verse)
(text verse)
(translations verse)
(notes verse)))
(defmethod to-sexp ((bible cons))
@ -101,8 +107,9 @@
:bsname (cadr sexp)
:chapter (caddr sexp)
:number (nth 3 sexp)
:text (nth 4 sexp)
:notes (nth 5 sexp)))
:translations (nth 4 sexp)
:notes (nth 6 sexp)))
(defun from-sexp (bible)
(mapcar #'verse-from-sexp bible))