Added a lot of bibles.

clog.lisp

@@ -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")
+                 '(("Bible" "bible" :select (("Menge" :mng)
-                                             ("King James Version" "kjv")
+                                             ("King James Version" :kjv)
-                                             ("Vulgata" "vul")
+                                             ("Vulgata" :vul)
-                                             ("Greek Bible" "grb"))))
+                                             ("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)

data.lisp

@@ -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 *translation* :mng)
-(defvar *vul*)
-(defvar *grb*)
-(defvar *kjv*)
 (defvar *bible*)
 
 (defun load-bibles ()
   (ensure-directories-exist (uiop:native-namestring "~/.bible/"))
-  (if (uiop:file-exists-p (uiop:native-namestring "~/.bible/menge.sexp"))
+  (if (uiop:file-exists-p (uiop:native-namestring "~/.bible/bible.sexp"))
-      (progn
+      (setf *bible* (load-bible "~/.bible/bible.sexp"))
-        (setf *mng* (load-bible "~/.bible/menge.sexp"))
+      (setf *bible*
-        (setf *vul* (load-bible "~/.bible/vulgata.sexp"))
+            (load-bible
-        (setf *grb* (load-bible "~/.bible/greek.sexp"))
+             (asdf:system-relative-pathname :cl-bible
-        (setf *kjv* (load-bible "~/.bible/kjv.sexp")))
+                                            "resources/bible.sexp")))))
-      (progn
-        (setf *mng* (init-bible "mng"))
-        (setf *kjv* (init-bible "kjv"))
-        (setf *vul* (init-bible "vul"))
-        (setf *grb* (init-bible "grb")))))
 
 (load-bibles)
 
-(defun update-bible (str)
+(defun update-bible (translation)
-  (let ((bibles `(("mng" . ,*mng*)
+  (setf *translation* (intern translation :keyword)))
-                  ("kjv" . ,*kjv*)
-                  ("vul" . ,*vul*)
-                  ("grb" . ,*grb*))))
-  (setf *bible* (cdr (assoc str bibles :test #'string=)))))
 
-(defun persist-bible (bible filename)
+(defun persist-bible (bible filename filepath)
-  (with-open-file (file (uiop:native-namestring (concatenate 'string "~/.bible/" filename ".sexp"))
+  (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 ()
+(defun persist (&optional (filepath "~/.bible/"))
-  (let ((bibles (list *mng* *vul* *grb* *kjv*))
+  (ensure-directories-exist (uiop:native-namestring filepath))
-        (files '("menge" "vulgata" "greek" "kjv")))
+  (persist-bible *bible* "bible" filepath))
-    (ensure-directories-exist (uiop:native-namestring "~/.bible/"))
+
-    (mapcar #'persist-bible bibles files)))
+(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))

package.lisp

@@ -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))
 

search.lisp

@@ -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))

verse.lisp

@@ -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))
+(defgeneric verse-to-string (verse &key separator translation))
-(defmethod verse-to-string (verse &key (separator " "))
+(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))
+(defgeneric verse-to-clog (verse parent &key translation))
-(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj))
+(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
-  (let* ((verse-string (verse-to-string verse))
+  (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)
+                 :translations (nth 4 sexp)
-                 :notes (nth 5 sexp)))
+                 :notes (nth 6 sexp)))
 
 (defun from-sexp (bible)
   (mapcar #'verse-from-sexp bible))
+