;;;; 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 "
") (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~^
~}" 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))