Added possibility to add notes.

README.md

@@ -1,3 +1,6 @@
 # cl-bible
-## Screenshots
 ![Screenshot](screenshot.png)
+
+## installation
+
+You need sbcl and quicklisp set up.

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

clog.lisp

@@ -24,8 +24,7 @@
     (create-p div :content (ergebnis/se
                             (length results)))
     (mapc (lambda (verse)
-            (create-p div :content
+            (v:verse-to-clog verse div))
-                      (v:verse-to-string verse)))
           results)))
 
 (defun searcher (window)
@@ -59,16 +58,15 @@
                                            :width 650)))
            (div (create-div win)))
       (mapc (lambda (verse)
-              (create-p div :content
+              (v:verse-to-clog verse div))
-                        (v:verse-to-string verse)))
             (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")
+                 '(("Book" "book" :text)
-                   ("Chapter" "chapter" :text "Chapter"))
+                   ("Chapter" "chapter" :text))
                  (load-chapter body)
                  :title "Load a Chapter")))
 
@@ -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)

data.lisp

@@ -10,11 +10,22 @@
                   "cl-bible"
                   (format nil "resources/~A.tsv" bible))))))
 
-(defvar *bible*)
+(defun load-bible (filename)
-(defvar *mng* (init-bible))
+  (v:from-sexp
-(defvar *vul* (init-bible "vul"))
+   (read-from-string
-(defvar *grb* (init-bible "grb"))
+    (uiop:read-file-string (uiop:native-namestring filename)))))
-(defvar *kjv* (init-bible "kjv"))
+
+(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)))

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

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))
+(defgeneric verse-to-string (verse &key separator))
-(defmethod verse-to-string (verse &optional (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 "<br/>"))
+
+(defmethod verse-to-string ((verse verse) &key (separator "<br/>"))
   (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~^<br/>~}" 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))