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

Update to new GUI, some changes behind the scenes.

master
Silas Vedder 2 years ago
parent
f9b3486f34
commit
56576a728c
7 changed files with 124 additions and 348 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. 69
      chapter.lisp
  2. 185
      clog.lisp
  3. 118
      data.lisp
  4. 2
      lift-search.lisp
  5. 8
      package.lisp
  6. 56
      search.lisp
  7. 34
      verse.lisp

69
chapter.lisp
Unescape View File

@ -4,50 +4,30 @@
((%verses :initarg :verses
:reader verses)))
(defgeneric chapter-to-clog (chapter parent &key translation))
(defgeneric book/chapter-window (canvas title))
(defgeneric chapter-to-clog (chapter parent))
(defgeneric book/chapter-window (canvas))
(defgeneric translations-drop-down (div display chapter drop-down))
(defgeneric display-chapter-or-book (canvas title chapter))
(defgeneric display-chapter-or-book (canvas chapter))
(defgeneric load-chapter (canvas book chapter))
(defgeneric load-book (canvas book))
(defgeneric load-position (canvas pos))
(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj) &key (translation :mng))
(defmethod chapter-to-clog ((chapter chapter) (parent clog:clog-obj))
(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)))
))
(create-p parent
:content (concatenate 'string
(if (string= (v:vnumber verse) "1")
(format nil "<b>~A ~A:</b><br/>"
(v:bname verse)
(v:chapter verse))
"")
(v:verse-to-string verse)))))
(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 500)))
(mbar (create-gui-menu-bar win))
(drop-down (create-gui-menu-drop-down mbar :content "Translations")))
(values (create-div win)
drop-down)))
(defmethod book/chapter-window (canvas)
(create-div (create-web-content (create-web-main canvas))))
(defmethod translations-drop-down ((div clog:clog-div) display (chapter chapter) drop-down)
(mapcar
(lambda (translation)
(labels ((callback (obj)
(declare (ignore obj))
(d:update-bible (third translation))))
(create-gui-menu-item drop-down
:content (first translation)
:on-click #'callback)))
d:*translations*))
(defmethod display-chapter-or-book (canvas (title string) (chapter chapter))
(multiple-value-bind (div drop-down)
(book/chapter-window canvas title)
(let ((display (chapter-to-clog chapter div :translation d:*translation*)))
(translations-drop-down div display chapter drop-down))))
(defmethod display-chapter-or-book (canvas (chapter chapter))
(chapter-to-clog chapter (book/chapter-window canvas)))
(defmethod load-chapter (canvas (book string) (chapter string))
(let* ((bk (s:find-book d:*bible* book))
@ -56,24 +36,9 @@
: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)
(make-instance 'chapter :verses verses))))
(defmethod load-book ((canvas clog:clog-body) (book string))
(display-chapter-or-book canvas
(format nil "~A: ~A"
d:*translation*
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)))))

185
clog.lisp
Unescape View File

@ -5,9 +5,8 @@
(defvar *body*)
(defun lift-search-window (body search)
(let ((result (mapcar #'car (l:lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
(let ((result (mapcar #'car (l:lift-search search))))
(create-p body
:content (str:join ", " (if result
result
'("No results"))))))
@ -15,43 +14,22 @@
(defun ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
(defun test (canvas)
(create-gui-window canvas :title "Test"
:height 400
:width 300))
(defun test (canvas)
(let* ((win (window-content
(create-gui-window canvas :title "Test"
:height 300
:width 400)))
(button (create-button win :content "click me!"))
(div (create-div win)))
(create-p div :content "foo")
(set-on-click button (lambda (obj)
(declare (ignore obj))
(format t "Clicked button!")))
div))
(defun search-in-bible (phrase bible canvas)
(let* ((win (window-content
(create-gui-window canvas
:title (format nil "~A: ~A"
d:*translation*
phrase)
:height 400
:width 500)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
(set-on-click lift-search (lambda (obj)
(declare (ignore obj))
(lift-search-window canvas results)))
(create-p div :content (ergebnis/se
(length results)))
(let ((content (create-web-content canvas))
(results (s:find-in-bible bible phrase)))
(create-p content :content (format nil "<b>~A</b>" (ergebnis/se (length results))))
(let ((lift-search (create-web-panel content)))
(set-on-click (create-button lift-search :content "Lift Search")
(lambda (obj)
(declare (ignore obj))
(lift-search-window lift-search results))))
(mapc (lambda (verse)
(clog:set-on-click
(v:verse-to-clog verse div :translation d:*translation*)
(create-p content
:content (format nil "<b>~A ~A:</b><br />~A"
(v:bname verse)
(v:chapter verse)
(v:verse-to-string verse)))
(lambda (obj)
(declare (ignore obj))
(ch:load-chapter canvas
@ -59,108 +37,63 @@
(v:chapter verse)))))
results)))
(defun %bible-book-or-chapter (bible book chapter)
(if (string= book "")
bible
(let ((book (s:find-book bible book)))
(if (string= chapter "")
book
(s:find-chapter book chapter)))))
(defun search-with-chapter (window data)
(let ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(phrase (cadr (assoc "phrase" data :test #'string=))))
(search-in-bible phrase
(%bible-book-or-chapter d:*bible* book chapter)
window)))
(defun searcher (window)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "What do you want to search?"
'(("Phrase" "phrase" :text)
("Book" "book" :text)
("Chapter" "chapter" :text))
(lambda (data)
(search-with-chapter window data))
:title "Search a phrase")))
(defun reload (window)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which bible do you want?"
'(("Bible" "bible" :select (("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))))
(lambda (results)
(d:update-bible (cadar results))
:title "Load a Bible"))))
(let ((dialog (clog-web-form window "Which bible do you want?"
'(("Bible" "bible" :select (("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))))
(lambda (results)
(d:update-bible (form-result results "bible")))))))))
(defun load-book-or-chapter (canvas)
(lambda (data)
(ch:load-position canvas
(second (assoc "pos" data :test #'string=)))))
(defun get-chapter (window body)
(defun get-chapter (body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which passage do you want?"
(clog-web-form body "Which passage do you want?"
'(("" "pos" :text))
(load-book-or-chapter body)
:title "Load a Passage")))
(defun setup-window (body)
(let ((window (create-gui-window body :title "background"
:hidden t)))
(window-normalize window)
(window-center window)
window))
(defun setup-menu-bar (body window)
(let* ((mbar (create-gui-menu-bar body))
(drop-down (create-gui-menu-drop-down mbar
:content "Options")))
(create-gui-menu-full-screen mbar)
(create-gui-menu-item drop-down
:content "Search"
:on-click (searcher window))
(create-gui-menu-item drop-down
:content "Get Chapter"
:on-click (get-chapter window body))
(create-gui-menu-item drop-down
:content "Load Bible"
:on-click (reload window))
(create-gui-menu-item mbar
:content "Close all windows"
:on-click (lambda (obj)
(declare (ignore obj))
(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)
(declare (ignore obj))
(d:persist)))
(create-gui-menu-item mbar
:content "Load notes"
:on-click (lambda (obj)
(declare (ignore obj))
(d:load-bibles)))))
(load-book-or-chapter body))))
(defun setup-menu-bar (body)
(let* ((form-space (create-web-content body))
(form2 (create-form form-space))
(bible (create-select form2 :label (create-label form2 :content "Choose your translation: ")))
(_ (create-br form-space))
(form1 (create-form form-space))
(passage (create-form-element form1 :search :class "w3-input w3-border"))
(__ (create-br form-space))
(form3 (create-form form-space))
(search (create-form-element form3 :search :class "w3-input w3-border")))
(declare (ignore _ __))
(add-select-options bible '("elb1871" "mng" "neue" "luth1545" "luth1912" "sch1951" "kjv" "vul" "grb" "ukr"))
(set-on-change bible (lambda (obj)
(declare (ignore obj))
(d:update-bible (value bible))))
(create-form-element form1 :submit :value "Get passage")
(set-on-submit form1
(lambda (obj)
(declare (ignore obj))
(ch:load-position body (value passage))))
(create-form-element form3 :submit :value "Search phrase")
(set-on-submit form3
(lambda (obj)
(declare (ignore obj))
(search-in-bible (value search) d:*bible* body)))))
(defun on-new-window (body)
(setf *body* body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)
(setup-menu-bar body (setup-window body)))
(clog-web-initialize body)
(setup-menu-bar body))

118
data.lisp
Unescape View File

@ -18,122 +18,8 @@
(uiop:read-file-lines
(uiop:native-namestring (concatenate 'string "~/.bible/" filename ".tsv")))))
(defun load-bible (filename)
(v:from-sexp
(read-from-string
(uiop:read-file-string (uiop:native-namestring filename)))))
(defvar *translation* :mng)
(defvar *bible* nil)
(defun load-bibles ()
(ensure-directories-exist (uiop:native-namestring "~/.bible/"))
(if (uiop:file-exists-p (uiop:native-namestring "~/.bible/bible.sexp"))
(setf *bible* (load-bible "~/.bible/bible.sexp"))
(setf *bible*
(load-bible
(asdf:system-relative-pathname :cl-bible
"resources/bible.sexp")))))
(load-bibles)
(defvar *translation* :vul)
(defvar *bible* (read-bible-from-tsv "vul"))
(defun update-bible (translation)
(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"))
:direction :output
:if-exists :overwrite
:if-does-not-exist :create)
(print (v:to-sexp bible) file)))
(defun persist (&optional (filepath "~/.bible/"))
(ensure-directories-exist (uiop:native-namestring filepath))
(persist-bible *bible* "bible" filepath))
(defvar mapping '(("Genesis" . "Genesis")
("Exodus" . "Exodus")
("Levitikus" . "Levitikus")
("Numeri" . "Numeri")
("Deuteronomium" . "Deuteronomium")
("Josua" . "Josua")
("Richter" . "Richter")
("Rut" . "Ruth")
("1 Samuel" . "1 Samuel")
("2 Samuel" . "2 Samuel")
("1 Könige" . "1 Könige")
("2 Könige" . "2 Könige")
("1 Chronik" . "1 Chronika")
("2 Chronik" . "2 Chronika")
("Esra" . "Esra")
("Nehemia" . "Nehemia")
("Ester" . "Esther")
("Ijob" . "Hiob")
("Psalmen" . "Psalmen")
("Sprüche" . "Sprüche")
("Kohelet" . "Kohelet")
("Hohelied" . "Hohelied")
("Jesaja" . "Jesaja")
("Jeremia" . "Jeremia")
("Klagelieder" . "Klagelieder")
("Ezechiel" . "Hesekiel")
("Daniel" . "Daniel")
("Hosea" . "Hosea")
("Joël" . "Joel")
("Amos" . "Amos")
("Obadja" . "Obadja")
("Jona" . "Jona")
("Micha" . "Micha")
("Nahum" . "Nahum")
("Habakuk" . "Habakuk")
("Zephanja" . "Zephania")
("Haggai" . "Haggai")
("Sacharja" . "Sacharia")
("Maleachi" . "Maleachi")
("Matthäus" . "Matthäus")
("Markus" . "Markus")
("Lukas" . "Lukas")
("Johannes" . "Johannes")
("Apostelgeschichte" . "Apostelgeschichte")
("Römer" . "Römer")
("1 Korinther" . "1 Korinther")
("2 Korinther" . "2 Korinther")
("Galater" . "Galater")
("Epheser" . "Epheser")
("Philipper" . "Philipper")
("Kolosser" . "Kolosser")
("1 Thessalonicher" . "1 Thessalonicher")
("2 Thessalonicher" . "2 Thessalonicher")
("1 Timotheus" . "1 Timotheus")
("2 Timotheus" . "2 Timotheus")
("Titus" . "Titus")
("Philemon" . "Philemon")
("Hebräer" . "Hebräer")
("Jakobus" . "Jakobus")
("1 Petrus" . "1 Petrus")
("2 Petrus" . "2 Petrus")
("1 Johannes" . "1 Johannes")
("2 Johannes" . "2 Johannes")
("3 Johannes" . "3 Johannes")
("Judas" . "Judas")
("Offenbarung" . "Offenbarung")
("Judit" . "Judit")
("Weisheit" . "Weisheit")
("Tobit" . "Tobit")
("Sirach" . "Sirach")
("Baruch" . "Baruch")
("1 Makkabäer" . "1 Makkabäer")
("2 Makkabäer" . "2 Makkabäer")
("xDaniel" . "xDaniel")
("Manasse" . "Manasse")
("xEster" . "xEster")))
(defun add-bible (bible new mapping)
(mapc (lambda (map)
(mapc (lambda (old new)
(nconc (v:translations new)
(v::translations old)))
(cl-bible.search:find-book bible (car map))
(cl-bible.search:find-book new (cdr map))))
mapping))

2
lift-search.lisp
Unescape View File

@ -20,7 +20,7 @@
(funcall f1 (apply f2 args))))
(defun lift-search (search-result)
(comb (diff-verses (mapcar (compose #'normalize-string #'v:get-text)
(comb (diff-verses (mapcar (compose #'normalize-string #'v:text)
search-result))
(length search-result)))

8
package.lisp
Unescape View File

@ -1,8 +1,8 @@
;;;; package.lisp
;;; package.lisp
(defpackage #:cl-bible.verse
(:use #:cl)
(:export verse-to-clog
(:export verse-to-string
string-to-verse
to-sexp
from-sexp
@ -43,7 +43,7 @@
(:export lift-search))
(defpackage #:cl-bible.chapter
(:use #:cl #:clog #:clog-gui)
(:use #:cl #:clog #:clog-gui #:clog-web)
(:local-nicknames (#:d #:cl-bible.data)
(#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
@ -52,7 +52,7 @@
load-position))
(defpackage #:cl-bible.clog
(:use #:cl #:clog #:clog-gui)
(:use #:cl #:clog #:clog-gui #:clog-web)
(:local-nicknames (#:l #:cl-bible.lift-search)
(#:d #:cl-bible.data)
(#:s #:cl-bible.search)

56
search.lisp
Unescape View File

@ -3,7 +3,7 @@
(in-package #:cl-bible.search)
(defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
(remove-if-not (lambda (verse) (search phrase (v:text verse)))
bible))
(defmethod find-book (bible book)
@ -15,7 +15,7 @@
(defmethod find-verse (chapter verse)
(remove-if-not (lambda (v) (string= verse (v:vnumber v))) chapter))
(defclass position ()
(defclass pos ()
((book :initarg :book
:reader book)
(start :initarg :start
@ -32,19 +32,33 @@
: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)))
(defmethod parse-position :around ((position string))
(cond ((string= position "") nil)
((find #\space position) (call-next-method))
(t (make-instance 'pos :book position))))
(defmethod parse-position ((position string))
(let* ((first-split (uiop:split-string position :separator '(#\space)))
(split (if (ignore-errors (parse-integer (first first-split)))
(cons (format nil "~A ~A" (first first-split)
(second first-split))
(cddr first-split))
first-split)))
(if (cdr split)
(parse-position split)
(make-instance 'pos :book (first split)))))
(defmethod parse-position ((position cons))
(destructuring-bind (book rest)
position
(if (find #\- rest)
(destructuring-bind (start end)
(uiop:split-string rest :separator '(#\-))
(make-instance 'pos :book book
:start (parse-verse-pos start)
:end (parse-verse-pos end)))
(make-instance 'pos :book book
:start (parse-verse-pos rest)))))
(defun parse-verse-pos (verse-pos)
(if (find #\, verse-pos)
@ -54,16 +68,16 @@
:verse (parse-integer verse)))
(make-instance 'verse-pos :chapter (parse-integer verse-pos))))
(defmethod bookp ((pos position))
(defmethod bookp ((pos pos))
(if (start pos) nil t))
(defmethod rangep ((pos position))
(defmethod rangep ((pos pos))
(if (end pos) t nil))
(defmethod versep ((pos verse-pos))
(if (verse pos) t nil))
(defmethod versep ((pos position))
(defmethod versep ((pos pos))
(versep (start pos)))
(defun find-position (bible position)
@ -86,10 +100,10 @@ the requested verse/s"
(find-verse chapter (format nil "~A" (verse start))))
chapter)))))
(defmethod find-book (bible (pos position))
(defmethod find-book (bible (pos pos))
(find-book bible (book pos)))
(defmethod find-chapter (bible (pos position))
(defmethod find-chapter (bible (pos pos))
(let ((book (find-book bible pos)))
(if (bookp pos)
book
@ -101,7 +115,7 @@ the requested verse/s"
:append (find-chapter book (format nil "~A" chapter)))
(find-chapter book (format nil "~A" (chapter start))))))))
(defmethod find-verse (bible (pos position))
(defmethod find-verse (bible (pos pos))
(let ((chapter (find-chapter bible pos)))
(if (bookp pos)
chapter

34
verse.lisp
Unescape View File

@ -21,14 +21,13 @@
:accessor notes)))
(defgeneric string-to-verse (string))
(defgeneric verse-to-string (verse &key separator translation))
(defgeneric verse-to-string (verse))
(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))
@ -44,26 +43,16 @@
:number (fifth verse)
:text (sixth verse))))
(defmethod verse-to-string ((verse cons) &key (separator " ") translation)
(declare (ignore translation))
(defmethod verse-to-string ((verse cons))
(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 :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)
(if (translations verse)
(cdr (assoc translation (translations verse)))
(text verse)))))
(defmethod verse-to-string ((verse verse))
(format nil "~A ~A"
(vnumber verse)
(text verse)))
(defmethod verse-to-latex ((verse verse) &key translation (port t))
(declare (ignore translation))
@ -75,13 +64,6 @@
(translations verse)))
'(:mng :luth1545 :luth1912 :sch1951 :elb1871 :neue))))
(defmethod get-text ((verse verse))
(let ((translations (translations verse)))
(if translations
(cdr (assoc cl-bible.data:*translation*
translations))
(text verse))))
(defmethod %format-notes ((notes cons))
(format nil "~{~A~^<br/>~}" notes))
@ -124,10 +106,6 @@
(declare (ignore obj))
(push (clog:value text) (notes verse))))))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
(clog:create-p parent :content (verse-to-string verse :translation translation)))
(defmethod to-sexp ((verse verse))
(list (bname verse)
(bsname verse)

Write Preview
Loading…
Cancel
Save