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

A lot of changes - partly UI redesign, partly data redesign

master
Silas Vedder 2 years ago
parent
0dffd44f75
commit
f9b3486f34
6 changed files with 262 additions and 116 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 73
      chapter.lisp
  2. 35
      clog.lisp
  3. 34
      data.lisp
  4. 7
      package.lisp
  5. 107
      search.lisp
  6. 98
      verse.lisp

73
chapter.lisp
Unescape View File

@ -1,56 +1,79 @@
(in-package #:cl-bible.chapter)
(defun book/chapter-window (canvas title)
(defclass chapter ()
((%verses :initarg :verses
:reader verses)))
(defgeneric chapter-to-clog (chapter parent &key translation))
(defgeneric book/chapter-window (canvas title))
(defgeneric translations-drop-down (div display chapter drop-down))
(defgeneric display-chapter-or-book (canvas title chapter))
(defgeneric load-chapter (canvas book chapter))
(defgeneric load-book (canvas book))
(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj) &key (translation :mng))
(labels ((verse-to-clog (verse)
;;; (clog:set-on-click
(v:verse-to-clog verse parent :translation translation)
;;; (lambda (obj)
;;; (declare (ignore obj))
;;; (v::show-notes verse parent)))
))
(mapcar #'verse-to-clog (verses chapter))))
(defmethod book/chapter-window (canvas (title string))
(let* ((win (window-content
(create-gui-window canvas
:title title
:height 400
:width 650)))
:width 500)))
(mbar (create-gui-menu-bar win))
(drop-down (create-gui-menu-drop-down mbar :content "Translations")))
(values (create-div win)
drop-down)))
(defun translations-drop-down (div display verses drop-down)
(defmethod translations-drop-down ((div clog:clog-div) display (chapter chapter) drop-down)
(mapcar
(lambda (translation)
(labels ((verse-to-clog (verse)
(v:verse-to-clog verse
div
:translation (second translation)))
(hide-verse (verse) (setf (hiddenp verse) t))
(callback (obj)
(labels ((callback (obj)
(declare (ignore obj))
(mapc #'hide-verse display)
(setf display (mapcar #'verse-to-clog verses))))
(d:update-bible (third translation))))
(create-gui-menu-item drop-down
:content (first translation)
:on-click #'callback)))
d:*translations*))
(defun display-chapter-or-book (canvas title verses)
(defmethod display-chapter-or-book (canvas (title string) (chapter chapter))
(multiple-value-bind (div drop-down)
(book/chapter-window canvas title)
(flet ((verse-to-clog (verse)
(v:verse-to-clog verse
div
:translation d:*translation*)))
(let ((display (mapcar #'verse-to-clog verses)))
(translations-drop-down div display verses drop-down)))))
(defun load-chapter (canvas book chapter)
(let ((display (chapter-to-clog chapter div :translation d:*translation*)))
(translations-drop-down div display chapter drop-down))))
(defmethod load-chapter (canvas (book string) (chapter string))
(let* ((bk (s:find-book d:*bible* book))
(verses (if (find #\- chapter)
(loop :for chap :in (uiop:split-string chapter :separator '(#\-))
:append (s:find-chapter bk chap))
(s:find-chapter bk chapter))))
(display-chapter-or-book canvas
(format nil "~A: ~A ~A"
d:*translation*
book
chapter)
(s:find-chapter
(s:find-book d:*bible* book)
chapter)))
(make-instance 'chapter :verses verses))))
(defun load-book (canvas book)
(defmethod load-book ((canvas clog:clog-body) (book string))
(display-chapter-or-book canvas
(format nil "~A: ~A"
d:*translation*
book)
(s:find-book d:*bible* book)))
(make-instance 'chapter
:verses (s:find-book d:*bible* book))))
(defmethod load-position ((canvas clog:clog-body) (pos string))
(display-chapter-or-book canvas
(format nil "~A: ~A"
d:*translation*
pos)
(make-instance 'chapter
:verses (s:find-verse d:*bible* (s:parse-position pos)))))

35
clog.lisp
Unescape View File

@ -40,7 +40,7 @@
d:*translation*
phrase)
:height 400
:width 650)))
:width 500)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
@ -50,7 +50,13 @@
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
(clog:set-on-click
(v:verse-to-clog verse div :translation d:*translation*)
(lambda (obj)
(declare (ignore obj))
(ch:load-chapter canvas
(v:bname verse)
(v:chapter verse)))))
results)))
(defun %bible-book-or-chapter (bible book chapter)
@ -100,23 +106,19 @@
(defun load-book-or-chapter (canvas)
(lambda (data)
(let* ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=))))
(if (string= chapter "")
(ch:load-book canvas book)
(ch:load-chapter canvas book chapter)))))
(ch:load-position canvas
(second (assoc "pos" data :test #'string=)))))
(defun get-chapter (window body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which chapter do you want?"
'(("Book" "book" :text)
("Chapter" "chapter" :text))
(form-dialog window "Which passage do you want?"
'(("" "pos" :text))
(load-book-or-chapter body)
:title "Load a Chapter")))
:title "Load a Passage")))
(defun setup-window (body)
(let ((window (create-gui-window body :title "Search"
(let ((window (create-gui-window body :title "background"
:hidden t)))
(window-normalize window)
(window-center window)
@ -140,9 +142,12 @@
:content "Close all windows"
:on-click (lambda (obj)
(declare (ignore obj))
(loop for win = (current-window body)
unless win do (return)
do (window-close win))))
(loop :for win = (current-window body)
:if (or (null win)
(string= (window-title win)
"background"))
:do (return)
:do (window-close win))))
(create-gui-menu-item mbar
:content "Save notes"
:on-click (lambda (obj)

34
data.lisp
Unescape View File

@ -2,16 +2,21 @@
(in-package #:cl-bible.data)
(defvar *translations* '(("Menge" :mng)
("King James Version" :kjv)
("Vulgata" :vul)
("Greek Bible" :grb)
("Elberfelder Übersetzung 1871" :elb1871)
("NEÜ" :neue)
("Luther 1545" :luth1545)
("Luther 1912" :luth1912)
("Schlachter 1951" :sch1951)
("Ukrainische Version" :ukr)))
(defvar *translations* '(("Menge" :mng "mng")
("King James Version" :kjv "kjv")
("Vulgata" :vul "vul")
("Greek Bible" :grb "grb")
("Elberfelder Übersetzung 1871" :elb1871 "elb1871")
("NEÜ" :neue "neue")
("Luther 1545" :luth1545 "luth1545")
("Luther 1912" :luth1912 "luth1912")
("Schlachter 1951" :sch1951 "sch1951")
("Ukrainische Version" :ukr "ukr")))
(defun read-bible-from-tsv (filename)
(mapcar #'v:string-to-verse
(uiop:read-file-lines
(uiop:native-namestring (concatenate 'string "~/.bible/" filename ".tsv")))))
(defun load-bible (filename)
(v:from-sexp
@ -19,7 +24,7 @@
(uiop:read-file-string (uiop:native-namestring filename)))))
(defvar *translation* :mng)
(defvar *bible*)
(defvar *bible* nil)
(defun load-bibles ()
(ensure-directories-exist (uiop:native-namestring "~/.bible/"))
@ -33,7 +38,8 @@
(load-bibles)
(defun update-bible (translation)
(setf *translation* (intern translation :keyword)))
(setf *translation* (intern translation :keyword))
(setf *bible* (read-bible-from-tsv (string-downcase translation))))
(defun persist-bible (bible filename filepath)
(with-open-file (file (uiop:native-namestring (concatenate 'string filepath filename ".sexp"))
@ -123,10 +129,10 @@
("Manasse" . "Manasse")
("xEster" . "xEster")))
(defun add-bible (bible new name mapping)
(defun add-bible (bible new mapping)
(mapc (lambda (map)
(mapc (lambda (old new)
(push (cons name (v:text new))
(nconc (v:translations new)
(v::translations old)))
(cl-bible.search:find-book bible (car map))
(cl-bible.search:find-book new (cdr map))))

7
package.lisp
Unescape View File

@ -20,7 +20,9 @@
(:local-nicknames (#:v #:cl-bible.verse))
(:export find-in-bible
find-book
find-chapter))
find-chapter
find-verse
parse-position))
(defpackage #:cl-bible.data
(:use #:cl)
@ -46,7 +48,8 @@
(#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
(:export load-chapter
load-book))
load-book
load-position))
(defpackage #:cl-bible.clog
(:use #:cl #:clog #:clog-gui)

107
search.lisp
Unescape View File

@ -6,8 +6,111 @@
(remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
bible))
(defun find-book (bible book)
(defmethod find-book (bible book)
(remove-if-not (lambda (verse) (search book (v:bname verse))) bible))
(defun find-chapter (book chapter)
(defmethod find-chapter (book chapter)
(remove-if-not (lambda (verse) (string= chapter (v:chapter verse))) book))
(defmethod find-verse (chapter verse)
(remove-if-not (lambda (v) (string= verse (v:vnumber v))) chapter))
(defclass position ()
((book :initarg :book
:reader book)
(start :initarg :start
:initform nil
:reader start)
(end :initarg :end
:initform nil
:reader end)))
(defclass verse-pos ()
((chapter :initarg :chapter
:reader chapter)
(verse :initarg :verse
:initform nil
:reader verse)))
(defun parse-position (position)
(if (find #\space position)
(destructuring-bind (book rest)
(uiop:split-string position :separator '(#\space))
(if (find #\- rest)
(destructuring-bind (start end)
(uiop:split-string rest :separator '(#\-))
(make-instance 'position :book book
:start (parse-verse-pos start)
:end (parse-verse-pos end)))
(make-instance 'position :book book
:start (parse-verse-pos rest))))
(make-instance 'position :book position)))
(defun parse-verse-pos (verse-pos)
(if (find #\, verse-pos)
(destructuring-bind (chapter verse)
(uiop:split-string verse-pos :separator '(#\,))
(make-instance 'verse-pos :chapter (parse-integer chapter)
:verse (parse-integer verse)))
(make-instance 'verse-pos :chapter (parse-integer verse-pos))))
(defmethod bookp ((pos position))
(if (start pos) nil t))
(defmethod rangep ((pos position))
(if (end pos) t nil))
(defmethod versep ((pos verse-pos))
(if (verse pos) t nil))
(defmethod versep ((pos position))
(versep (start pos)))
(defun find-position (bible position)
"Accepts a bible citation of the form \"Genesis 18,32\" and returns
the requested verse/s"
(let ((pos (parse-position position)))
(with-accessors ((book book)
(start start)
(end end))
pos
(let* ((book (find-book bible book))
(chapter (if (rangep pos)
(loop :for chapter :from (chapter start) :to (chapter end)
:append (find-chapter book (format nil "~A" chapter)))
(find-chapter book (format nil "~A" (chapter start))))))
(if (versep pos)
(if (rangep pos)
(loop :for verse :from (verse start) :to (verse end)
:append (find-verse chapter (format nil "~A" verse)))
(find-verse chapter (format nil "~A" (verse start))))
chapter)))))
(defmethod find-book (bible (pos position))
(find-book bible (book pos)))
(defmethod find-chapter (bible (pos position))
(let ((book (find-book bible pos)))
(if (bookp pos)
book
(with-accessors ((start start)
(end end))
pos
(if (rangep pos)
(loop :for chapter :from (chapter start) :to (chapter end)
:append (find-chapter book (format nil "~A" chapter)))
(find-chapter book (format nil "~A" (chapter start))))))))
(defmethod find-verse (bible (pos position))
(let ((chapter (find-chapter bible pos)))
(if (bookp pos)
chapter
(with-accessors ((start start)
(end end))
pos
(if (versep pos)
(if (rangep pos)
(loop :for verse :from (verse start) :to (verse end)
:append (find-verse chapter (format nil "~A" verse)))
(find-verse chapter (format nil "~A" (verse start))))
chapter)))))

98
verse.lisp
Unescape View File

@ -20,19 +20,31 @@
:initform '()
:accessor notes)))
(defgeneric string-to-verse (string))
(defgeneric verse-to-string (verse &key separator translation))
(defgeneric verse-to-latex (verse &key translation port))
(defgeneric get-text (verse))
(defgeneric %format-notes (notes))
(defgeneric %create-notes-window (verse parent))
(defgeneric show-notes (verse parent))
(defgeneric add-notes (verse parent))
(defgeneric verse-to-clog (verse parent &key translation))
(defgeneric to-sexp (verse))
(defgeneric verse-from-sexp (sexp))
(defgeneric from-sexp (bible))
(defmethod print-object ((verse verse) stream)
(format stream (verse-to-string verse :separator " ")))
(defun string-to-verse (string)
(defmethod string-to-verse ((string 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))))
(make-instance 'verse :bname (first verse)
:bsname (second verse)
:chapter (fourth verse)
:number (fifth verse)
:text (sixth verse))))
(defgeneric verse-to-string (verse &key separator translation))
(defmethod verse-to-string (verse &key (separator " ") translation)
(defmethod verse-to-string ((verse cons) &key (separator " ") translation)
(declare (ignore translation))
(format nil "~A ~A:~A~A~A" (cadr verse)
(nth 3 verse)
@ -40,16 +52,19 @@
separator
(nth 5 verse)))
(defmethod verse-to-string ((verse verse)
&key (separator "<br/>")
(translation :mng))
(format nil "~A ~A:~A~A ~A" (bsname verse)
(defmethod verse-to-string ((verse verse) &key (separator "<br/>") (translation :elb1871))
(concatenate 'string
(when (string= (vnumber verse) "1")
(format nil "<b>~A ~A</b>~A"
(bname verse)
(chapter verse)
separator))
(format nil "~A ~A"
(vnumber verse)
separator
(cdr (assoc translation (translations verse)))))
(if (translations verse)
(cdr (assoc translation (translations verse)))
(text 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~%~} \\\\~%"
@ -60,17 +75,20 @@
(translations verse)))
'(:mng :luth1545 :luth1912 :sch1951 :elb1871 :neue))))
(defgeneric get-text (verse))
(defmethod get-text ((verse verse))
(let ((translations (translations verse)))
(if translations
(cdr (assoc cl-bible.data:*translation*
(translations verse))))
translations))
(text verse))))
(defmethod %format-notes ((notes cons))
(format nil "~{~A~^<br/>~}" notes))
(defun %format-notes (notes)
(if notes
(format nil "~{~A~^<br/>~}" notes)
"No notes found"))
(defmethod %format-notes ((notes (eql nil)))
"No notes found")
(defun %create-notes-window (verse parent)
(defmethod %create-notes-window ((verse verse) (parent clog:clog-obj))
(let ((win (clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Notes"
@ -80,8 +98,6 @@
(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
@ -89,7 +105,7 @@
(declare (ignore obj))
(add-notes verse parent)))))
(defun %create-add-notes-window (parent)
(defmethod %create-add-notes-window ((parent clog:clog-obj))
(let* ((form (clog:create-form
(clog-gui:window-content
(clog-gui:create-gui-window parent
@ -100,7 +116,6 @@
(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)
@ -109,19 +124,10 @@
(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))
(clog:create-p parent :content (verse-to-string verse :translation translation)))
(defgeneric to-sexp (verse))
(defmethod to-sexp ((verse verse))
(list (bname verse)
(bsname verse)
@ -133,14 +139,14 @@
(defmethod to-sexp ((bible cons))
(mapcar #'to-sexp bible))
(defun verse-from-sexp (sexp)
(defmethod verse-from-sexp ((sexp cons))
(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)
:bname (first sexp)
:bsname (second sexp)
:chapter (fourth sexp)
:number (fifth sexp)
:text (sixth sexp)
:notes (seventh sexp)))
(defmethod from-sexp ((bible cons))
(mapcar #'verse-from-sexp bible))

Write Preview
Loading…
Cancel
Save