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

Lot of changes

master
Silas Vedder 3 years ago
parent
c9f5ae2b9c
commit
26fca1d1e3
6 changed files with 113 additions and 71 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. 6
      README.md
  2. BIN
      bible
  3. 48
      clog.lisp
  4. 23
      lift-search.lisp
  5. 3
      search.lisp
  6. 68
      verse.lisp

6
README.md
Unescape View File

@ -9,10 +9,8 @@ Then do
$ git clone https://github.com/silasfox/cl-bible.git ~/quicklisp/local-projects
$ mkdir -p ~/.bible
$ cp ~/quicklisp/local-projects/cl-bible/resources/*.sexp ~/.bible/
$ sbcl
* (ql:quickload :cl-bible)
* (in-package :cl-bible-user)
* (start)
$ make
$ sudo make install
```
## bibles

BIN
bible
View File

Binary file not shown.

48
clog.lisp
Unescape View File

@ -3,20 +3,20 @@
(in-package #:cl-bible.clog)
(defun lift-search-window (body search)
(lambda (obj)
(declare (ignore obj))
(let ((result (mapcar #'car (l:lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
:content (str:join ", " result)))))
:content (str:join ", " (if result
result
'("No results"))))))
(defun ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
(defun search-in-bible (phrase bible canvas)
(let* ((win (window-content
(create-gui-window canvas :title
(format nil "~A: ~A"
(create-gui-window canvas
:title (format nil "~A: ~A"
d:*translation*
phrase)
:height 400
@ -24,7 +24,9 @@
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(set-on-click lift-search (lambda (obj)
(declare (ignore obj))
(lift-search-window canvas results)))
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
@ -39,14 +41,13 @@
book
(s:find-chapter book chapter)))))
(defun search-with-chapter (window)
(lambda (data)
(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))))
window)))
(defun searcher (window)
(lambda (obj)
@ -55,7 +56,8 @@
'(("Phrase" "phrase" :text)
("Book" "book" :text)
("Chapter" "chapter" :text))
(search-with-chapter window)
(lambda (data)
(search-with-chapter window data))
:title "Search a phrase")))
(defun reload (window)
@ -84,28 +86,29 @@
(load-book canvas book)
(load-chapter canvas book chapter)))))
(defun book/chapter-window (canvas title)
(create-div
(window-content
(create-gui-window canvas
:title title
:height 400
:width 650))))
(defun load-book (canvas book)
(let* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A"
(let ((div (book/chapter-window canvas
(format nil "~A: ~A"
d:*translation*
book)
:height 400
:width 650)))
(div (create-div win)))
book))))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
(s:find-book d:*bible* book))))
(defun load-chapter (canvas book chapter)
(let* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A ~A"
(let ((div (book/chapter-window canvas
(format nil "~A: ~A ~A"
d:*translation*
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
chapter))))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
(s:find-chapter (s:find-book d:*bible* book) chapter))))
@ -158,7 +161,6 @@
(declare (ignore obj))
(d:load-bibles)))))
(defun on-new-window (body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)

23
lift-search.lisp
Unescape View File

@ -2,10 +2,26 @@
(in-package #:cl-bible.lift-search)
(defun frequent-words () (str:words "der die das dir mir wir ihr sie sein mein dein euer unser dem den in zu und"))
(defun frequent-words ()
(str:words "der die das dir mir wir ihr sie sein mein dein euer unser dem den in zu und"))
(defparameter *punctuation*
'(#\; #\: #\' #\" #\. #\, #\« #\» #\( #\) #\[ #\] #\{ #\} #\! #\? #\-))
(defun normalize-string (str)
(map 'string (lambda (char)
(if (member char *punctuation*)
#\space
char))
str))
(defun compose (f1 f2)
(lambda (&rest args)
(funcall f1 (apply f2 args))))
(defun lift-search (search-result)
(comb (diff-verses (mapcar #'v:get-text search-result))
(comb (diff-verses (mapcar (compose #'normalize-string #'v:get-text)
search-result))
(length search-result)))
(defun count-words (words)
@ -19,7 +35,8 @@
(> (cdr x) (cdr y))))))
(defun diff-verses (verses)
(count-words (remove-if (lambda (word) (member word
(count-words (remove-if (lambda (word)
(member word
(frequent-words)
:test #'string=))
(mapcan #'str:words verses))))

3
search.lisp
Unescape View File

@ -3,8 +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:get-text verse)))
bible))
(defun find-book (bible book)

68
verse.lisp
Unescape View File

@ -49,35 +49,61 @@
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))))
(cdr (assoc cl-bible.data:*translation*
(translations verse))))
(defmethod show-notes ((verse verse) (parent clog:clog-obj))
(let* ((win (clog-gui:create-gui-window parent
:title "Notes"
:content (let ((notes (notes verse)))
(defun %format-notes (notes)
(if notes
(format nil "~{~A~^<br/>~}" notes)
"No notes found"))))
(_ (clog:create-br (clog-gui:window-content win)))
(button (clog:create-button (clog-gui:window-content win)
"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")))
(declare (ignore _))
(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)))))
(defmethod add-notes ((verse verse) (parent clog:clog-obj))
(let* ((win (clog-gui:window-content
(defun %create-add-notes-window (parent)
(let* ((form (clog:create-form
(clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Add note")))
(form (clog:create-form win))
(text (clog:create-text-area form :rows 4))
(_ (clog:create-br form))
(button (clog:create-button form :content "submit")))
(declare (ignore _))
: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))
@ -85,9 +111,10 @@
(defgeneric verse-to-clog (verse parent &key translation))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
(let* ((verse-string (verse-to-string verse :translation translation))
(display (clog:create-p parent
:content verse-string)))
(let ((display
(clog:create-p parent
:content (verse-to-string verse
:translation translation))))
(clog:set-on-click display
(lambda (obj)
(declare (ignore obj))
@ -116,4 +143,3 @@
(defun from-sexp (bible)
(mapcar #'verse-from-sexp bible))

Write Preview
Loading…
Cancel
Save