From 51aa9c81ff10612422f8c3b2c6840d15e8e5293f Mon Sep 17 00:00:00 2001 From: Silas Vedder Date: Mon, 9 May 2022 09:40:45 +0200 Subject: [PATCH] Added possibility to add notes. --- README.md | 5 +++- cl-bible.lisp | 3 +- clog.lisp | 28 ++++++++++++------- data.lisp | 34 +++++++++++++++++++---- package.lisp | 21 ++++++++++++-- verse.lisp | 76 +++++++++++++++++++++++++++++++++++++++++++++++---- 6 files changed, 142 insertions(+), 25 deletions(-) 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))