|
|
|
;;;; search.lisp
|
|
|
|
|
|
|
|
(in-package #:cl-bible.verse)
|
|
|
|
|
|
|
|
(defclass verse ()
|
|
|
|
((%bname :initarg :bname
|
|
|
|
:reader bname)
|
|
|
|
(%bsname :initarg :bsname
|
|
|
|
:reader bsname)
|
|
|
|
(%chapter :initarg :chapter
|
|
|
|
:reader chapter)
|
|
|
|
(%number :initarg :number
|
|
|
|
:reader vnumber)
|
|
|
|
(%text :initarg :text
|
|
|
|
:reader text)
|
|
|
|
(%translations :initarg :translations
|
|
|
|
:initform '()
|
|
|
|
:accessor translations)
|
|
|
|
(%notes :initarg :notes
|
|
|
|
:initform '()
|
|
|
|
:accessor notes)))
|
|
|
|
|
|
|
|
(defmethod print-object ((verse verse) stream)
|
|
|
|
(format stream (verse-to-string verse :separator " ")))
|
|
|
|
|
|
|
|
(defun string-to-verse (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))))
|
|
|
|
|
|
|
|
(defgeneric verse-to-string (verse &key separator translation))
|
|
|
|
(defmethod verse-to-string (verse &key (separator " ") translation)
|
|
|
|
(declare (ignore translation))
|
|
|
|
(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)
|
|
|
|
&key (separator "<br/>")
|
|
|
|
(translation :mng))
|
|
|
|
(format nil "~A ~A:~A~A ~A" (bsname verse)
|
|
|
|
(chapter verse)
|
|
|
|
(vnumber verse)
|
|
|
|
separator
|
|
|
|
(cdr (assoc translation (translations 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~%~} \\\\~%"
|
|
|
|
(bname verse)
|
|
|
|
(chapter verse)
|
|
|
|
(vnumber verse)
|
|
|
|
(mapcar (lambda (trans) (assoc trans
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
(defun %format-notes (notes)
|
|
|
|
(if notes
|
|
|
|
(format nil "~{~A~^<br/>~}" notes)
|
|
|
|
"No notes found"))
|
|
|
|
|
|
|
|
(defun %create-notes-window (verse parent)
|
|
|
|
(let ((win (clog-gui:window-content
|
|
|
|
(clog-gui:create-gui-window parent
|
|
|
|
:title "Notes"
|
|
|
|
:content (%format-notes
|
|
|
|
(notes verse))))))
|
|
|
|
(clog:create-br win)
|
|
|
|
(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
|
|
|
|
(lambda (obj)
|
|
|
|
(declare (ignore obj))
|
|
|
|
(add-notes verse parent)))))
|
|
|
|
|
|
|
|
(defun %create-add-notes-window (parent)
|
|
|
|
(let* ((form (clog:create-form
|
|
|
|
(clog-gui:window-content
|
|
|
|
(clog-gui:create-gui-window parent
|
|
|
|
:title "Add note"))))
|
|
|
|
(text (clog:create-text-area form :rows 4
|
|
|
|
:columns 40)))
|
|
|
|
(clog:create-br form)
|
|
|
|
(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)
|
|
|
|
(clog:set-on-click button
|
|
|
|
(lambda (obj)
|
|
|
|
(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))
|
|
|
|
|
|
|
|
(defgeneric to-sexp (verse))
|
|
|
|
(defmethod to-sexp ((verse verse))
|
|
|
|
(list (bname verse)
|
|
|
|
(bsname verse)
|
|
|
|
(chapter verse)
|
|
|
|
(vnumber verse)
|
|
|
|
(translations 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)
|
|
|
|
:translations (nth 4 sexp)
|
|
|
|
:notes (nth 6 sexp)))
|
|
|
|
|
|
|
|
(defun from-sexp (bible)
|
|
|
|
(mapcar #'verse-from-sexp bible))
|