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 2 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. 74
      clog.lisp
  4. 27
      lift-search.lisp
  5. 3
      search.lisp
  6. 72
      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.

74
clog.lisp
Unescape View File

@ -3,28 +3,30 @@
(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)))))
(let ((result (mapcar #'car (l:lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
: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"
d:*translation*
phrase)
(create-gui-window canvas
:title (format nil "~A: ~A"
d:*translation*
phrase)
:height 400
:width 650)))
(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)
(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 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)
@ -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"
d:*translation*
book)
:height 400
:width 650)))
(div (create-div win)))
(let ((div (book/chapter-window canvas
(format nil "~A: ~A"
d:*translation*
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"
d:*translation*
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
(let ((div (book/chapter-window canvas
(format nil "~A: ~A ~A"
d:*translation*
book
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)

27
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,9 +35,10 @@
(> (cdr x) (cdr y))))))
(defun diff-verses (verses)
(count-words (remove-if (lambda (word) (member word
(frequent-words)
:test #'string=))
(count-words (remove-if (lambda (word)
(member word
(frequent-words)
:test #'string=))
(mapcan #'str:words verses))))
(defun comb (freqs length)

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)

72
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))))
(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* ((win (clog-gui:create-gui-window parent
:title "Notes"
:content (let ((notes (notes verse)))
(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)
:content "Add notes")))
(declare (ignore _))
(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))
(let* ((win (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 _))
(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