silasfox/cl-bible
1
0
Fork 0
Code Issues 3 Pull Requests Projects 1 Releases Wiki Activity

Added possibility to add notes.

Browse Source
This commit is contained in:
Silas Vedder 2022-05-09 09:40:45 +02:00
parent 90233cd7ed
commit 51aa9c81ff
6 changed files with 142 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
README.md
View File

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

3
cl-bible.lisp
View File

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

28
clog.lisp
View File

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

34
data.lisp
View File

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

21
package.lisp
View File

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

76
verse.lisp
View File

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