Update to new GUI, some changes behind the scenes.

chapter.lisp

@@ -4,50 +4,30 @@
   ((%verses :initarg :verses
             :reader verses)))
 
-(defgeneric chapter-to-clog (chapter parent &key translation))
+(defgeneric chapter-to-clog (chapter parent))
-(defgeneric book/chapter-window (canvas title))
+(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
+             (create-p parent
-              (v:verse-to-clog verse parent :translation translation)
+                       :content (concatenate 'string
-;;;              (lambda (obj)
+                                             (if (string= (v:vnumber verse) "1")
-;;;                (declare (ignore obj))
+                                                 (format nil "<b>~A ~A:</b><br/>"
-;;;                (v::show-notes verse parent)))
+                                                         (v:bname verse)
-             ))
+                                                         (v:chapter verse))
+                                                 "")
+                                             (v:verse-to-string verse)))))
     (mapcar #'verse-to-clog (verses chapter))))
 
-(defmethod book/chapter-window (canvas (title string))
+(defmethod book/chapter-window (canvas)
-  (let* ((win (window-content
+  (create-div (create-web-content (create-web-main canvas))))
-               (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 translations-drop-down ((div clog:clog-div) display (chapter chapter) drop-down)
+(defmethod display-chapter-or-book (canvas (chapter chapter))
-  (mapcar
+  (chapter-to-clog chapter (book/chapter-window canvas)))
-   (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 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)))))

clog.lisp

@@ -5,9 +5,8 @@
 (defvar *body*)
 
 (defun lift-search-window (body search)
-  (let ((result (mapcar #'car (l:lift-search search)))
+  (let ((result (mapcar #'car (l:lift-search search))))
-        (win (create-gui-window body)))
+    (create-p body
-    (create-p (window-content win)
               :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
+  (let ((content (create-web-content canvas))
-               (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)
+    (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 canvas results)))
+                      (lift-search-window lift-search results))))
-    (create-p div :content (ergebnis/se
-                            (length 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,37 +37,10 @@
                                 (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?"
+    (let ((dialog (clog-web-form window "Which bible do you want?"
                    '(("Bible" "bible" :select (("Menge" :mng)
                                                ("King James Version" :kjv)
                                                ("Vulgata" :vul)
@@ -101,66 +52,48 @@
                                                ("Schlachter 1951" :sch1951)
                                                ("Ukrainische Version" :ukr))))
                                                (lambda (results)
-                   (d:update-bible (cadar results))
+                                                 (d:update-bible (form-result results "bible")))))))))
-                   :title "Load a 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)
+                 (load-book-or-chapter body))))
-                 :title "Load a Passage")))
 
-(defun setup-window (body)
+(defun setup-menu-bar (body)
-  (let ((window (create-gui-window body :title "background"
+  (let* ((form-space (create-web-content body))
-                                        :hidden t)))
+         (form2 (create-form form-space))
-    (window-normalize window)
+         (bible (create-select form2 :label (create-label form2 :content "Choose your translation: ")))
-    (window-center window)
+         (_ (create-br form-space))
-    window))
+         (form1 (create-form form-space))
-
+         (passage (create-form-element form1 :search :class "w3-input w3-border"))
-(defun setup-menu-bar (body window)
+         (__ (create-br form-space))
-  (let* ((mbar (create-gui-menu-bar body))
+         (form3 (create-form form-space))
-         (drop-down (create-gui-menu-drop-down mbar
+         (search (create-form-element form3 :search :class "w3-input w3-border")))
-                                               :content "Options")))
+    (declare (ignore _ __))
-    (create-gui-menu-full-screen mbar)
+    (add-select-options bible '("elb1871" "mng" "neue" "luth1545" "luth1912" "sch1951" "kjv" "vul" "grb" "ukr"))
-    (create-gui-menu-item drop-down
+    (set-on-change bible (lambda (obj)
-                          :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)
+                           (d:update-bible (value bible))))
-                                            :if (or (null win)
+    (create-form-element form1 :submit :value "Get passage")
-                                                    (string= (window-title win)
+    (set-on-submit form1
-                                                             "background"))
+                   (lambda (obj)
-                                              :do (return) 
-                                              :do (window-close win))))
-    (create-gui-menu-item mbar
-                          :content "Save notes"
-                          :on-click (lambda (obj)
                      (declare (ignore obj))
-                                      (d:persist)))
+                     (ch:load-position body (value passage))))
-    (create-gui-menu-item mbar
+    (create-form-element form3 :submit :value "Search phrase")
-                          :content "Load notes"
+    (set-on-submit form3
-                          :on-click (lambda (obj)
+                   (lambda (obj)
                      (declare (ignore obj))
-                                      (d:load-bibles)))))
+                     (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)
+  (clog-web-initialize body)
-  (setup-menu-bar body (setup-window body)))
+  (setup-menu-bar body))

data.lisp

@@ -18,122 +18,8 @@
           (uiop:read-file-lines
            (uiop:native-namestring (concatenate 'string "~/.bible/" filename ".tsv")))))
 
-(defun load-bible (filename)
+(defvar *translation* :vul)
-  (v:from-sexp
+(defvar *bible* (read-bible-from-tsv "vul"))
-   (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)
 
 (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))

lift-search.lisp

@@ -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)))
 

package.lisp

@@ -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)

search.lisp

@@ -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)
+(defmethod parse-position :around ((position string))
-  (if (find #\space position)
+  (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)
-          (uiop:split-string position :separator '(#\space))
+      position
     (if (find #\- rest)
         (destructuring-bind (start end)
             (uiop:split-string rest :separator '(#\-))
-              (make-instance 'position :book book
+          (make-instance 'pos :book book
                               :start (parse-verse-pos start)
                               :end (parse-verse-pos end)))
-            (make-instance 'position :book book
+        (make-instance 'pos :book book
-                                     :start (parse-verse-pos rest))))
+                            :start (parse-verse-pos rest)))))
-      (make-instance 'position :book position)))
 
 (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

verse.lisp

@@ -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)
+(defmethod verse-to-string ((verse cons))
-  (declare (ignore translation))
   (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))
+(defmethod verse-to-string ((verse verse))
-  (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)
+          (text verse)))
-                           (cdr (assoc translation (translations 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)