You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
146 lines
4.9 KiB
146 lines
4.9 KiB
;;;; 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))
|
|
|