diff --git a/README.md b/README.md
index 179ef88..2ce4824 100644
--- a/README.md
+++ b/README.md
@@ -1,3 +1,6 @@
# cl-bible
-## Screenshots
![Screenshot](screenshot.png)
+
+## installation
+
+You need sbcl and quicklisp set up.
diff --git a/cl-bible.lisp b/cl-bible.lisp
index 70ba2bd..03c11b1 100644
--- a/cl-bible.lisp
+++ b/cl-bible.lisp
@@ -11,4 +11,5 @@
(loop))
(defun build ()
- (sb-ext:save-lisp-and-die "bible" :executable t :toplevel #'main))
+ (mapc (lambda (bible) (mapc (lambda (verse) (setf (cl-bible.verse:notes verse) nil)) bible)) (list cl-bible.data::*mng* cl-bible.data::*kjv* cl-bible.data::*vul* cl-bible.data::*grb*))
+ #+sbcl (sb-ext:save-lisp-and-die "bible" :executable t :toplevel #'main))
diff --git a/clog.lisp b/clog.lisp
index f97eab3..43f2079 100644
--- a/clog.lisp
+++ b/clog.lisp
@@ -22,10 +22,9 @@
(results (s:find-in-bible d:*bible* phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(create-p div :content (ergebnis/se
- (length results)))
+ (length results)))
(mapc (lambda (verse)
- (create-p div :content
- (v:verse-to-string verse)))
+ (v:verse-to-clog verse div))
results)))
(defun searcher (window)
@@ -45,7 +44,7 @@
("Greek Bible" "grb"))))
(lambda (results)
(d:update-bible (cadar results))
- :title "Load a Bible"))))
+ :title "Load a Bible"))))
(defun load-chapter (canvas)
(lambda (data)
@@ -59,16 +58,15 @@
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
- (create-p div :content
- (v:verse-to-string verse)))
+ (v:verse-to-clog verse div))
(s:find-chapter (s:find-book d:*bible* book) chapter)))))
(defun get-chapter (window body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which chapter do you want?"
- '(("Book" "book" :text "Book")
- ("Chapter" "chapter" :text "Chapter"))
+ '(("Book" "book" :text)
+ ("Chapter" "chapter" :text))
(load-chapter body)
:title "Load a Chapter")))
@@ -87,7 +85,7 @@
(create-gui-menu-item drop-down
:content "Search"
:on-click (searcher window))
- (create-gui-menu-item drop-down
+ (create-gui-menu-item drop-down
:content "Get Chapter"
:on-click (get-chapter window body))
(create-gui-menu-item drop-down
@@ -99,7 +97,17 @@
(declare (ignore obj))
(loop for win = (current-window body)
unless win do (return)
- do (window-close win))))))
+ 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)))))
(defun on-new-window (body)
diff --git a/data.lisp b/data.lisp
index 17564ba..45a152c 100644
--- a/data.lisp
+++ b/data.lisp
@@ -10,11 +10,22 @@
"cl-bible"
(format nil "resources/~A.tsv" bible))))))
-(defvar *bible*)
-(defvar *mng* (init-bible))
-(defvar *vul* (init-bible "vul"))
-(defvar *grb* (init-bible "grb"))
-(defvar *kjv* (init-bible "kjv"))
+(defun load-bible (filename)
+ (v:from-sexp
+ (read-from-string
+ (uiop:read-file-string (uiop:native-namestring filename)))))
+
+(defvar *mng* (load-bible "~/.bible/menge.sexp"))
+(defvar *vul* (load-bible "~/.bible/vulgata.sexp"))
+(defvar *grb* (load-bible "~/.bible/greek.sexp"))
+(defvar *kjv* (load-bible "~/.bible/kjv.sexp"))
+(defvar *bible* *mng*)
+
+(defun load-bibles ()
+ (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")))
(defun update-bible (str)
(let ((bibles `(("mng" . ,*mng*)
@@ -22,3 +33,16 @@
("vul" . ,*vul*)
("grb" . ,*grb*))))
(setf *bible* (cdr (assoc str bibles :test #'string=)))))
+
+(defun persist-bible (bible filename)
+ (with-open-file (file (uiop:native-namestring (concatenate 'string "~/.bible/" 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)))
diff --git a/package.lisp b/package.lisp
index a838223..8b09b1c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,13 +2,16 @@
(defpackage #:cl-bible.verse
(:use #:cl)
- (:export verse-to-string
+ (:export verse-to-clog
string-to-verse
+ to-sexp
+ from-sexp
bname
bsname
chapter
vnumber
- text))
+ text
+ notes))
(defpackage #:cl-bible.search
(:use #:cl)
@@ -28,7 +31,9 @@
(:local-nicknames (#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
(:export update-bible
- *bible*))
+ *bible*
+ persist
+ load-bibles))
(defpackage #:cl-bible.clog
(:use #:cl #:clog #:clog-gui)
@@ -42,4 +47,14 @@
(:use #:cl #:clog #:clog-gui)
(:local-nicknames (#:c #:cl-bible.clog))
(:export start
+ main
build))
+
+(defpackage #:cl-bible-user
+ (:use #:cl
+ #:cl-bible
+ #:cl-bible.verse
+ #:cl-bible.data
+ #:cl-bible.search)
+ (:local-nicknames (#:c #:clog)
+ (#:cg #:clog-gui)))
diff --git a/verse.lisp b/verse.lisp
index 4c08716..89ffa1d 100644
--- a/verse.lisp
+++ b/verse.lisp
@@ -12,10 +12,13 @@
(%number :initarg :number
:reader vnumber)
(%text :initarg :text
- :reader text)))
+ :reader text)
+ (%notes :initarg :notes
+ :initform '()
+ :accessor notes)))
(defmethod print-object ((verse verse) stream)
- (format stream (verse-to-string verse " ")))
+ (format stream (verse-to-string verse :separator " ")))
(defun string-to-verse (string)
(let ((verse (uiop:split-string string :separator '(#\Tab))))
@@ -25,16 +28,79 @@
:number (nth 4 verse)
:text (nth 5 verse))))
-(defgeneric verse-to-string (verse &optional separator))
-(defmethod verse-to-string (verse &optional (separator " "))
+(defgeneric verse-to-string (verse &key separator))
+(defmethod verse-to-string (verse &key (separator " "))
(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) &optional (separator "
"))
+
+(defmethod verse-to-string ((verse verse) &key (separator "
"))
(format nil "~A ~A:~A~A ~A" (bsname verse)
(chapter verse)
(vnumber verse)
separator
(text verse)))
+
+(defmethod show-notes ((verse verse) (parent clog:clog-obj))
+ (let* ((win (clog-gui:create-gui-window parent
+ :title "Notes"
+ :content (let ((notes (notes verse)))
+ (if notes
+ (format nil "~{~A~^
~}" notes)
+ "No notes found"))))
+ (_ (clog:create-br (clog-gui:window-content win)))
+ (button (clog:create-button (clog-gui:window-content win)
+ :content "Add notes")))
+ (declare (ignore _))
+ (clog:set-on-click button
+ (lambda (obj)
+ (declare (ignore obj))
+ (add-notes verse parent)))))
+
+(defmethod add-notes ((verse verse) (parent clog:clog-obj))
+ (let* ((win (clog-gui:window-content
+ (clog-gui:create-gui-window parent
+ :title "Add note")))
+ (form (clog:create-form win))
+ (text (clog:create-text-area form :rows 4))
+ (button (clog:create-button form :content "submit")))
+ (clog:set-on-click button
+ (lambda (obj)
+ (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))
+ (display (clog:create-p parent
+ :content verse-string)))
+ (clog:set-on-click display
+ (lambda (obj)
+ (declare (ignore obj))
+ (show-notes verse parent)))))
+
+(defgeneric to-sexp (verse))
+(defmethod to-sexp ((verse verse))
+ (list (bname verse)
+ (bsname verse)
+ (chapter verse)
+ (vnumber verse)
+ (text verse)
+ (notes verse)))
+
+(defmethod to-sexp ((bible cons))
+ (mapcar #'to-sexp bible))
+
+(defun verse-from-sexp (sexp)
+ (make-instance 'verse
+ :bname (car sexp)
+ :bsname (cadr sexp)
+ :chapter (caddr sexp)
+ :number (nth 3 sexp)
+ :text (nth 4 sexp)
+ :notes (nth 5 sexp)))
+
+(defun from-sexp (bible)
+ (mapcar #'verse-from-sexp bible))