diff --git a/chapter.lisp b/chapter.lisp
index 1591dd2..2df5a96 100644
--- a/chapter.lisp
+++ b/chapter.lisp
@@ -1,56 +1,79 @@
(in-package #:cl-bible.chapter)
-(defun book/chapter-window (canvas title)
+(defclass chapter ()
+ ((%verses :initarg :verses
+ :reader verses)))
+
+(defgeneric chapter-to-clog (chapter parent &key translation))
+(defgeneric book/chapter-window (canvas title))
+(defgeneric translations-drop-down (div display chapter drop-down))
+(defgeneric display-chapter-or-book (canvas title chapter))
+(defgeneric load-chapter (canvas book chapter))
+(defgeneric load-book (canvas book))
+
+(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj) &key (translation :mng))
+ (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)))
+ ))
+ (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 650)))
+ :width 500)))
(mbar (create-gui-menu-bar win))
(drop-down (create-gui-menu-drop-down mbar :content "Translations")))
(values (create-div win)
drop-down)))
-(defun translations-drop-down (div display verses drop-down)
+(defmethod translations-drop-down ((div clog:clog-div) display (chapter chapter) drop-down)
(mapcar
(lambda (translation)
- (labels ((verse-to-clog (verse)
- (v:verse-to-clog verse
- div
- :translation (second translation)))
- (hide-verse (verse) (setf (hiddenp verse) t))
- (callback (obj)
+ (labels ((callback (obj)
(declare (ignore obj))
- (mapc #'hide-verse display)
- (setf display (mapcar #'verse-to-clog verses))))
+ (d:update-bible (third translation))))
(create-gui-menu-item drop-down
:content (first translation)
:on-click #'callback)))
d:*translations*))
-(defun display-chapter-or-book (canvas title verses)
+(defmethod display-chapter-or-book (canvas (title string) (chapter chapter))
(multiple-value-bind (div drop-down)
(book/chapter-window canvas title)
- (flet ((verse-to-clog (verse)
- (v:verse-to-clog verse
- div
- :translation d:*translation*)))
- (let ((display (mapcar #'verse-to-clog verses)))
- (translations-drop-down div display verses drop-down)))))
-
-(defun load-chapter (canvas book chapter)
+ (let ((display (chapter-to-clog chapter div :translation d:*translation*)))
+ (translations-drop-down div display chapter drop-down))))
+
+(defmethod load-chapter (canvas (book string) (chapter string))
+ (let* ((bk (s:find-book d:*bible* book))
+ (verses (if (find #\- chapter)
+ (loop :for chap :in (uiop:split-string chapter :separator '(#\-))
+ :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)
- (s:find-chapter
- (s:find-book d:*bible* book)
- chapter)))
-
-(defun load-book (canvas book)
+ (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*
- book)
- (s:find-book d:*bible* book)))
+ (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 3677634..ab75d76 100644
--- a/clog.lisp
+++ b/clog.lisp
@@ -40,7 +40,7 @@
d:*translation*
phrase)
:height 400
- :width 650)))
+ :width 500)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
@@ -50,7 +50,13 @@
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
- (v:verse-to-clog verse div :translation d:*translation*))
+ (clog:set-on-click
+ (v:verse-to-clog verse div :translation d:*translation*)
+ (lambda (obj)
+ (declare (ignore obj))
+ (ch:load-chapter canvas
+ (v:bname verse)
+ (v:chapter verse)))))
results)))
(defun %bible-book-or-chapter (bible book chapter)
@@ -100,23 +106,19 @@
(defun load-book-or-chapter (canvas)
(lambda (data)
- (let* ((book (cadr (assoc "book" data :test #'string=)))
- (chapter (cadr (assoc "chapter" data :test #'string=))))
- (if (string= chapter "")
- (ch:load-book canvas book)
- (ch:load-chapter canvas book chapter)))))
+ (ch:load-position canvas
+ (second (assoc "pos" data :test #'string=)))))
(defun get-chapter (window body)
(lambda (obj)
(declare (ignore obj))
- (form-dialog window "Which chapter do you want?"
- '(("Book" "book" :text)
- ("Chapter" "chapter" :text))
+ (form-dialog window "Which passage do you want?"
+ '(("" "pos" :text))
(load-book-or-chapter body)
- :title "Load a Chapter")))
+ :title "Load a Passage")))
(defun setup-window (body)
- (let ((window (create-gui-window body :title "Search"
+ (let ((window (create-gui-window body :title "background"
:hidden t)))
(window-normalize window)
(window-center window)
@@ -140,9 +142,12 @@
:content "Close all windows"
:on-click (lambda (obj)
(declare (ignore obj))
- (loop for win = (current-window body)
- unless win do (return)
- do (window-close win))))
+ (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)
diff --git a/data.lisp b/data.lisp
index 906712b..d4aee1f 100644
--- a/data.lisp
+++ b/data.lisp
@@ -2,16 +2,21 @@
(in-package #:cl-bible.data)
-(defvar *translations* '(("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)))
+(defvar *translations* '(("Menge" :mng "mng")
+ ("King James Version" :kjv "kjv")
+ ("Vulgata" :vul "vul")
+ ("Greek Bible" :grb "grb")
+ ("Elberfelder Übersetzung 1871" :elb1871 "elb1871")
+ ("NEÜ" :neue "neue")
+ ("Luther 1545" :luth1545 "luth1545")
+ ("Luther 1912" :luth1912 "luth1912")
+ ("Schlachter 1951" :sch1951 "sch1951")
+ ("Ukrainische Version" :ukr "ukr")))
+
+(defun read-bible-from-tsv (filename)
+ (mapcar #'v:string-to-verse
+ (uiop:read-file-lines
+ (uiop:native-namestring (concatenate 'string "~/.bible/" filename ".tsv")))))
(defun load-bible (filename)
(v:from-sexp
@@ -19,7 +24,7 @@
(uiop:read-file-string (uiop:native-namestring filename)))))
(defvar *translation* :mng)
-(defvar *bible*)
+(defvar *bible* nil)
(defun load-bibles ()
(ensure-directories-exist (uiop:native-namestring "~/.bible/"))
@@ -33,7 +38,8 @@
(load-bibles)
(defun update-bible (translation)
- (setf *translation* (intern translation :keyword)))
+ (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"))
@@ -123,11 +129,11 @@
("Manasse" . "Manasse")
("xEster" . "xEster")))
-(defun add-bible (bible new name mapping)
+(defun add-bible (bible new mapping)
(mapc (lambda (map)
(mapc (lambda (old new)
- (push (cons name (v:text new))
- (v::translations old)))
+ (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/package.lisp b/package.lisp
index e4ac912..7509850 100644
--- a/package.lisp
+++ b/package.lisp
@@ -20,7 +20,9 @@
(:local-nicknames (#:v #:cl-bible.verse))
(:export find-in-bible
find-book
- find-chapter))
+ find-chapter
+ find-verse
+ parse-position))
(defpackage #:cl-bible.data
(:use #:cl)
@@ -46,7 +48,8 @@
(#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
(:export load-chapter
- load-book))
+ load-book
+ load-position))
(defpackage #:cl-bible.clog
(:use #:cl #:clog #:clog-gui)
diff --git a/search.lisp b/search.lisp
index 2540032..77fa1f6 100644
--- a/search.lisp
+++ b/search.lisp
@@ -6,8 +6,111 @@
(remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
bible))
-(defun find-book (bible book)
+(defmethod find-book (bible book)
(remove-if-not (lambda (verse) (search book (v:bname verse))) bible))
-(defun find-chapter (book chapter)
+(defmethod find-chapter (book chapter)
(remove-if-not (lambda (verse) (string= chapter (v:chapter verse))) book))
+
+(defmethod find-verse (chapter verse)
+ (remove-if-not (lambda (v) (string= verse (v:vnumber v))) chapter))
+
+(defclass position ()
+ ((book :initarg :book
+ :reader book)
+ (start :initarg :start
+ :initform nil
+ :reader start)
+ (end :initarg :end
+ :initform nil
+ :reader end)))
+
+(defclass verse-pos ()
+ ((chapter :initarg :chapter
+ :reader chapter)
+ (verse :initarg :verse
+ :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)))
+
+(defun parse-verse-pos (verse-pos)
+ (if (find #\, verse-pos)
+ (destructuring-bind (chapter verse)
+ (uiop:split-string verse-pos :separator '(#\,))
+ (make-instance 'verse-pos :chapter (parse-integer chapter)
+ :verse (parse-integer verse)))
+ (make-instance 'verse-pos :chapter (parse-integer verse-pos))))
+
+(defmethod bookp ((pos position))
+ (if (start pos) nil t))
+
+(defmethod rangep ((pos position))
+ (if (end pos) t nil))
+
+(defmethod versep ((pos verse-pos))
+ (if (verse pos) t nil))
+
+(defmethod versep ((pos position))
+ (versep (start pos)))
+
+(defun find-position (bible position)
+ "Accepts a bible citation of the form \"Genesis 18,32\" and returns
+the requested verse/s"
+ (let ((pos (parse-position position)))
+ (with-accessors ((book book)
+ (start start)
+ (end end))
+ pos
+ (let* ((book (find-book bible book))
+ (chapter (if (rangep pos)
+ (loop :for chapter :from (chapter start) :to (chapter end)
+ :append (find-chapter book (format nil "~A" chapter)))
+ (find-chapter book (format nil "~A" (chapter start))))))
+ (if (versep pos)
+ (if (rangep pos)
+ (loop :for verse :from (verse start) :to (verse end)
+ :append (find-verse chapter (format nil "~A" verse)))
+ (find-verse chapter (format nil "~A" (verse start))))
+ chapter)))))
+
+(defmethod find-book (bible (pos position))
+ (find-book bible (book pos)))
+
+(defmethod find-chapter (bible (pos position))
+ (let ((book (find-book bible pos)))
+ (if (bookp pos)
+ book
+ (with-accessors ((start start)
+ (end end))
+ pos
+ (if (rangep pos)
+ (loop :for chapter :from (chapter start) :to (chapter end)
+ :append (find-chapter book (format nil "~A" chapter)))
+ (find-chapter book (format nil "~A" (chapter start))))))))
+
+(defmethod find-verse (bible (pos position))
+ (let ((chapter (find-chapter bible pos)))
+ (if (bookp pos)
+ chapter
+ (with-accessors ((start start)
+ (end end))
+ pos
+ (if (versep pos)
+ (if (rangep pos)
+ (loop :for verse :from (verse start) :to (verse end)
+ :append (find-verse chapter (format nil "~A" verse)))
+ (find-verse chapter (format nil "~A" (verse start))))
+ chapter)))))
diff --git a/verse.lisp b/verse.lisp
index 1d1dd51..8d762f5 100644
--- a/verse.lisp
+++ b/verse.lisp
@@ -20,19 +20,31 @@
:initform '()
:accessor notes)))
+(defgeneric string-to-verse (string))
+(defgeneric verse-to-string (verse &key separator translation))
+(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))
+
(defmethod print-object ((verse verse) stream)
(format stream (verse-to-string verse :separator " ")))
-(defun string-to-verse (string)
+(defmethod string-to-verse ((string string))
(let ((verse (uiop:split-string string :separator '(#\Tab))))
- (make-instance 'verse :bname (car verse)
- :bsname (nth 1 verse)
- :chapter (nth 3 verse)
- :number (nth 4 verse)
- :text (nth 5 verse))))
+ (make-instance 'verse :bname (first verse)
+ :bsname (second verse)
+ :chapter (fourth verse)
+ :number (fifth verse)
+ :text (sixth verse))))
-(defgeneric verse-to-string (verse &key separator translation))
-(defmethod verse-to-string (verse &key (separator " ") translation)
+(defmethod verse-to-string ((verse cons) &key (separator " ") translation)
(declare (ignore translation))
(format nil "~A ~A:~A~A~A" (cadr verse)
(nth 3 verse)
@@ -40,16 +52,19 @@
separator
(nth 5 verse)))
-(defmethod verse-to-string ((verse verse)
- &key (separator "
")
- (translation :mng))
- (format nil "~A ~A:~A~A ~A" (bsname verse)
- (chapter verse)
- (vnumber verse)
- separator
- (cdr (assoc translation (translations 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)))))
-(defgeneric verse-to-latex (verse &key translation port))
(defmethod verse-to-latex ((verse verse) &key translation (port t))
(declare (ignore translation))
(format port "~A ~A ^{~A} ~%~{~A~%~} \\\\~%"
@@ -60,17 +75,20 @@
(translations verse)))
'(:mng :luth1545 :luth1912 :sch1951 :elb1871 :neue))))
-(defgeneric get-text (verse))
(defmethod get-text ((verse verse))
- (cdr (assoc cl-bible.data:*translation*
- (translations verse))))
+ (let ((translations (translations verse)))
+ (if translations
+ (cdr (assoc cl-bible.data:*translation*
+ translations))
+ (text verse))))
-(defun %format-notes (notes)
- (if notes
- (format nil "~{~A~^
~}" notes)
- "No notes found"))
+(defmethod %format-notes ((notes cons))
+ (format nil "~{~A~^
~}" notes))
-(defun %create-notes-window (verse parent)
+(defmethod %format-notes ((notes (eql nil)))
+ "No notes found")
+
+(defmethod %create-notes-window ((verse verse) (parent clog:clog-obj))
(let ((win (clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Notes"
@@ -80,8 +98,6 @@
(clog:create-button win
:content "Add notes")))
-
-(defgeneric show-notes (verse parent))
(defmethod show-notes ((verse verse) (parent clog:clog-obj))
(let ((button (%create-notes-window verse parent)))
(clog:set-on-click button
@@ -89,7 +105,7 @@
(declare (ignore obj))
(add-notes verse parent)))))
-(defun %create-add-notes-window (parent)
+(defmethod %create-add-notes-window ((parent clog:clog-obj))
(let* ((form (clog:create-form
(clog-gui:window-content
(clog-gui:create-gui-window parent
@@ -100,7 +116,6 @@
(values text
(clog:create-button form :content "submit"))))
-(defgeneric add-notes (verse parent))
(defmethod add-notes ((verse verse) (parent clog:clog-obj))
(multiple-value-bind (text button)
(%create-add-notes-window parent)
@@ -109,19 +124,10 @@
(declare (ignore obj))
(push (clog:value text) (notes verse))))))
-(defgeneric verse-to-clog (verse parent &key translation))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
- (let ((display
- (clog:create-p parent
- :content (verse-to-string verse
- :translation translation))))
- (clog:set-on-click display
- (lambda (obj)
- (declare (ignore obj))
- (show-notes verse parent)))
- display))
+ (clog:create-p parent :content (verse-to-string verse :translation translation)))
+
-(defgeneric to-sexp (verse))
(defmethod to-sexp ((verse verse))
(list (bname verse)
(bsname verse)
@@ -133,14 +139,14 @@
(defmethod to-sexp ((bible cons))
(mapcar #'to-sexp bible))
-(defun verse-from-sexp (sexp)
+(defmethod verse-from-sexp ((sexp cons))
(make-instance 'verse
- :bname (car sexp)
- :bsname (cadr sexp)
- :chapter (caddr sexp)
- :number (nth 3 sexp)
- :translations (nth 4 sexp)
- :notes (nth 6 sexp)))
-
-(defun from-sexp (bible)
+ :bname (first sexp)
+ :bsname (second sexp)
+ :chapter (fourth sexp)
+ :number (fifth sexp)
+ :text (sixth sexp)
+ :notes (seventh sexp)))
+
+(defmethod from-sexp ((bible cons))
(mapcar #'verse-from-sexp bible))