Browse Source

Lot of changes

master
Silas Vedder 3 years ago
parent
commit
26fca1d1e3
  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

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

BIN
bible

Binary file not shown.

48
clog.lisp

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

23
lift-search.lisp

@ -2,10 +2,26 @@
(in-package #:cl-bible.lift-search) (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) (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))) (length search-result)))
(defun count-words (words) (defun count-words (words)
@ -19,7 +35,8 @@
(> (cdr x) (cdr y)))))) (> (cdr x) (cdr y))))))
(defun diff-verses (verses) (defun diff-verses (verses)
(count-words (remove-if (lambda (word) (member word (count-words (remove-if (lambda (word)
(member word
(frequent-words) (frequent-words)
:test #'string=)) :test #'string=))
(mapcan #'str:words verses)))) (mapcan #'str:words verses))))

3
search.lisp

@ -3,8 +3,7 @@
(in-package #:cl-bible.search) (in-package #:cl-bible.search)
(defun find-in-bible (bible phrase) (defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase (remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
(v:get-text verse)))
bible)) bible))
(defun find-book (bible book) (defun find-book (bible book)

68
verse.lisp

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

Loading…
Cancel
Save