diff --git a/README.md b/README.md
index 4649b25..62cc1ff 100644
--- a/README.md
+++ b/README.md
@@ -4,15 +4,13 @@
## installation
You need sbcl and quicklisp set up.
-Then do
+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
diff --git a/bible b/bible
new file mode 100755
index 0000000..e74ebd2
Binary files /dev/null and b/bible differ
diff --git a/clog.lisp b/clog.lisp
index a85762f..dfa0203 100644
--- a/clog.lisp
+++ b/clog.lisp
@@ -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)
diff --git a/lift-search.lisp b/lift-search.lisp
index a525f63..274d090 100644
--- a/lift-search.lisp
+++ b/lift-search.lisp
@@ -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)
diff --git a/search.lisp b/search.lisp
index 0bb9616..2540032 100644
--- a/search.lisp
+++ b/search.lisp
@@ -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)
diff --git a/verse.lisp b/verse.lisp
index 4c066fa..e80d6a0 100644
--- a/verse.lisp
+++ b/verse.lisp
@@ -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~^
~}" 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~^
~}" 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))
-