ソースを参照

fix following verse references (from search) and cross references

Fred Gilham 5 日 前
コミット
b309e6d5b7
1 ファイル変更91 行追加76 行削除
  1. 91 76
      bible.el

+ 91 - 76
bible.el

@@ -731,6 +731,8 @@ Mostly in Psalms, like `Of David' or the like.")
 (defvar-local bible-search-range-this-query nil)
 (defvar-local bible-search-matches 0)
 
+(defvar bible-reference-buffer nil)
+
 ;;;;; Variables used in constructing cross-references.
 (defvar-local bible-current-xref-book nil)
 (defvar-local bible-current-xref-chapter nil)
@@ -749,18 +751,20 @@ Mostly in Psalms, like `Of David' or the like.")
 (defun bible-next-search-item ()
   "Go to next item in list of found verses."
   (interactive)
-  (search-forward-regexp bible--verse-regexp))
+  (search-forward-regexp bible--verse-regexp nil t))
 
 (defun bible-previous-search-item ()
   "Go to previous item in list of found verses."
   (interactive)
-  (search-backward-regexp bible--verse-regexp))
+  (when (search-backward-regexp bible--verse-regexp nil t)
+    (beginning-of-line)))
 
 (defun bible-toggle-display-xml ()
   "Toggle XML display."
   (interactive)
   (setq-local bible-debugme (not bible-debugme))
-  (bible--display))
+  (bible--display)
+  (goto-char (point-min)))
 
 (defun bible-toggle-text-direction ()
   "Switch between left-to-right and right-to-left text direction."
@@ -782,7 +786,7 @@ Mostly in Psalms, like `Of David' or the like.")
 
 ;;;;; Commands (interactive)
 
-(defun bible-open (&optional buffer book-name chapter verse module)
+(defun bible-open (&optional module book-name chapter verse buffer)
   "Create and open a `bible' buffer.
 Optional arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the
 starting verse reference for the buffer. If no optional location
@@ -794,19 +798,17 @@ specifies the module to use."
     (when module (setq-local bible-text module))
     (setq-local bible-buffer-type 'text
                 mode-name (concat "Text " bible-text))
-    (bible--set-location
-     (assoc (or book-name "Genesis") bible--books)
-     (or chapter 1)
-     verse)
     (cl-pushnew (current-buffer) bible--text-buffers)
+    (bible--set-location (assoc (or book-name "Genesis") bible--books) (or chapter 1) (or verse 1))
     (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
 
-(defun commentary-open (&optional buffer book-name chapter verse module)
+(defun commentary-open (&optional module book-name chapter verse buffer)
   "Create and open a `commentary' buffer.
 Optional argument MODULE specifies the commentary module to use.
 Optional arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the
 starting verse reference for the buffer. If no optional location
-arguments are supplied, Genesis 1:1 is used."
+arguments are supplied, Genesis 1:1 is used.
+Optional argument BUFFER gives a buffer into which to render the text."
   (interactive)
   (let ((old-buffer (current-buffer)))
     (unless old-buffer (error "No current buffer! How did this happen!"))
@@ -820,28 +822,27 @@ arguments are supplied, Genesis 1:1 is used."
       (bible--set-location
        (assoc (or book-name "Genesis") bible--books)
        (or chapter 1)
-       verse)
+       (or verse 1))
       (cl-pushnew (current-buffer) bible--commentary-buffers)
       (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer)))))
 
 ;;;;;; Navigation
 
 (defun bible--do-set-location (book chapter &optional verse)
-  (setq-local bible--current-book book)
-  (setq-local bible--current-book-name (car book))
+  (setq-local bible--current-book-name book)
   (setq-local bible--current-chapter chapter)
-  (bible--display verse))
+  (bible--display (or verse 1)))
 
 (defun bible--set-location (book chapter &optional verse)
   "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
   (let ((buffer (current-buffer)))
-    (bible--do-set-location book chapter verse)
+    (setq-local bible--current-book book)
+    (bible--do-set-location (car book) chapter (or verse 1))
     (when (cl-find buffer bible--synced-buffers)
-      (save-excursion
-        (dolist (buf bible--synced-buffers)
-          (unless (eq buf buffer)
-            (with-current-buffer buf
-              (bible--do-set-location book chapter verse))))))))
+      (dolist (buf bible--synced-buffers)
+        (unless (eq buf buffer)
+          (with-current-buffer buf
+            (bible--do-set-location (car book) chapter (or verse 1))))))))
 
 (defun bible-next-chapter ()
   "Page to the next chapter for the active `bible' buffer and 
@@ -855,7 +856,8 @@ for any synchronized buffers."
   "Page to the previous chapter for the active `bible' buffer and
 for any synchronized buffers."
   (interactive)
-  (bible--set-location bible--current-book (max 1 (1- bible--current-chapter))))
+  (let ((chapter (max 1 (1- bible--current-chapter))))
+    (bible--set-location bible--current-book chapter)))
 
 (defun bible-next-word ()
   "Move forward a word, taking into account the relevant text properties."
@@ -910,11 +912,11 @@ by the menu item `Select Text'."
   (interactive)
   (let ((item (get-text-property (point) 'module)))
     (rename-buffer "*bible*" t)
-    (bible-open (current-buffer)
+    (bible-open item
                 bible--current-book-name 
                 bible--current-chapter 
                 1 
-                item)))
+                (current-buffer))))
 
 (defun bible-pick-commentary ()
   "Select a commentary from a list. Re-use the buffer listing the commentaries.
@@ -922,11 +924,11 @@ Called by the menu item `Select Commentary'."
   (interactive)
   (let ((item (get-text-property (point) 'module)))
     (rename-buffer "*comm*" t)
-    (commentary-open (current-buffer)
+    (commentary-open item
                      bible--current-book-name 
                      bible--current-chapter 
                      1
-                     item)))
+                     (current-buffer))))
 
 (defun bible--new-window (name)
   "Open a new window and generate a new buffer with NAME.
@@ -946,11 +948,11 @@ commentary window, use new buffer and new window."
                              (bible--new-window "*bible*")
                            (current-buffer))
       (setq-local bible-text text)
-      (bible-open (current-buffer)
+      (bible-open text
                   bible--current-book-name 
                   bible--current-chapter 
                   1 
-                  text))))
+                  (current-buffer)))))
 
 (defun bible-select-commentary (commentary)
   "Promp for a new commentary module for the current `commentary' buffer.
@@ -963,11 +965,11 @@ window."
                              (bible--new-window "*comm*")
                            (current-buffer))
       (setq-local bible-commentary commentary)
-      (commentary-open (current-buffer)
+      (commentary-open commentary
                        bible--current-book-name 
                        bible--current-chapter 
                        1 
-                       commentary))))
+                       (current-buffer)))))
 
 ;;;;;; Toggles
 
@@ -996,18 +998,26 @@ window."
       (setq-local bible--synced-p t))
     (force-mode-line-update)))
 
+;;(defun bible-split-display ()
+;;  "Copy the active `bible' buffer into a new buffer in another window."
+;;  (interactive)
+;;  (split-window-right)
+;;  (balance-windows)
+;;  (other-window 1)
+;;  (bible-open bible-text
+;;              bible--current-book-name
+;;              bible--current-chapter
+;;              1
+;;              (generate-new-buffer "*bible*")))
+
 (defun bible-split-display ()
   "Copy the active `bible' buffer into a new buffer in another window."
   (interactive)
-  (split-window-right)
-  (balance-windows)
-  (other-window 1)
-  (bible-open 
-   (generate-new-buffer "*bible*")
-   bible--current-book-name
-   bible--current-chapter
-   1
-   bible-text))
+  (bible-open bible-text
+              bible--current-book-name
+              bible--current-chapter
+              1
+              (bible--new-window "*bible*")))
 
 ;;;;;; Search helpers
 
@@ -1019,41 +1029,44 @@ window."
         (setq bible-search-range nil)
       (setq bible-search-range range))))
 
-(defun bible-search (query)
+(defun bible-search (query searchmode)
   "Search for a QUERY: a word or phrase.
 Asks the user for type of search: either `lucene', `phrase', `regex'
 or `multiword'.  `lucene' is the default search.
 `lucene' mode requires an index to be built using the `mkfastmod' program."
-  (interactive "sBible Search: ")
+  (interactive (let ((query (read-string "Query: ")))
+                 (if (> (length query) 0)
+                     (list query (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene"))
+                   (list nil nil))))
   (when (> (length query) 0)
-    (let ((searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
-      (bible--open-search query searchmode (buffer-local-value 'bible-text (current-buffer))))))
+    (setq bible-reference-buffer (current-buffer))
+    (bible--open-search query searchmode (buffer-local-value 'bible-text (current-buffer)))))
+
 
-(defvar-local bible-search-reference-buffer nil)
+(defun bible--lookup-abbrev (name)
+  "Find the canonican book entry for NAME in bible--books."
+  (or (cl-find name bible--books :key #'car :test #'string-equal-ignore-case)
+      (cl-find (alist-get name bible--book-name-abbreviations nil nil #'string-equal-ignore-case)
+               bible--books
+               :key #'car 
+               :test #'string-equal-ignore-case)))
 
 (defun bible-follow-verse ()
   "Follow the hovered verse in a bible search mode buffer.
 Create a new `bible' buffer positioned at the selected verse."
   (interactive)
-  (let* ((text (thing-at-point 'line t))
-         book
-         chapter
-         verse)
-    (when (string-match bible--verse-regexp text)
-      (setq text (match-string 0 text))
-      (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
-      (setq book (match-string 0 text))
-      (string-match "[0-9]?[0-9]?[0-9]?:" text)
-      (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
-      (string-match ":[0-9]?[0-9]?[0-9]?" text)
-      (setq verse (substring (match-string 0 text) 1))
-      (unless bible-search-reference-buffer
-        (setq-local bible-search-reference-buffer (generate-new-buffer "*bible*")))
-      (bible-open bible-search-reference-buffer
-                  (string-trim book)
-                  (string-to-number chapter)
-                  (string-to-number verse)
-                  bible-text))))
+  (let ((verse-ref (thing-at-point 'line t)))
+    (when (string-match bible--verse-regexp verse-ref)
+      (let* ((verse-ref-string (match-string 0 verse-ref))
+             (book (when (string-match "I?I?I? ?[A-Z]?[a-z]* " verse-ref-string)
+                     (string-trim (match-string 0 verse-ref-string))))
+             (chapter (when (string-match "[0-9]?[0-9]?[0-9]?:" verse-ref-string)
+                        (string-to-number 
+                         (substring verse-ref-string (match-beginning 0) (1- (match-end 0))))))
+             (verse (when (string-match ":[0-9]?[0-9]?[0-9]?" verse-ref-string)
+                      (string-to-number (substring (match-string 0 verse-ref-string) 1)))))
+        (pop-to-buffer bible-reference-buffer)
+        (bible--set-location (assoc book bible--books) chapter verse)))))
 
 (defun bible-follow-xref ()
   "Follow the hovered verse in a bible term or commentary buffer.
@@ -1070,7 +1083,8 @@ Handle abbreviations."
                      chapter-verse (split-string (cadr verse-ref) ":")))
               ((= (length verse-ref) 3) ; II Cor 3:17 or the like
                (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
-                     chapter-verse (split-string (caddr verse-ref) ":"))))
+                     chapter-verse (split-string (caddr verse-ref) ":")))
+              (t (error "Invalid verse ref %s" verse-ref)))
         ;; Use book abbreviation if present or try whatever is in verse-ref.
         (let ((book (or (alist-get book-abbrev
                                    bible--book-name-abbreviations
@@ -1078,13 +1092,10 @@ Handle abbreviations."
                                    nil
                                    #'string-equal-ignore-case)
                         (car verse-ref)))
-              (chapter (car chapter-verse))
-              (verse (cadr chapter-verse)))
-          (bible-open bible-associated-buffer 
-                      (string-trim book)
-                      (string-to-number chapter)
-                      (string-to-number verse)
-                      (default-value 'bible-text)))))))
+              (chapter (string-to-number (car chapter-verse)))
+              (verse (string-to-number (cadr chapter-verse))))
+          (pop-to-buffer (or bible-associated-buffer (cl-first bible--text-buffers)))
+          (bible--set-location (assoc book bible--books) chapter verse))))))
 
 
 ;;;;;; User visible actions.
@@ -1714,11 +1725,12 @@ If optional argument VERSE is supplied, set cursor at verse."
                                 (" ?" . "? ")
                                 (" !" . "! ")
                                 ("“ " . "“")
+                                (" ”" . "”")
                                 ("‘ " . "‘")
                                 (" ’" . "’")
-                                (". ”" . ".”")
-                                ("? ”" . "?”"))
-                              nil (point-min) (point-max)))
+;;                                (". ”" . ".”")
+                                ("? ”" . "?”")) 
+                             nil (point-min) (point-max)))
     ;; Get rid of multiple consecutive spaces.
     (save-excursion
       (while (re-search-forward "  *" nil t) ; More than one space in a row
@@ -1732,8 +1744,8 @@ If optional argument VERSE is supplied, set cursor at verse."
       (setq mode-name (replace-regexp-in-string " Morph" "" mode-name)))
     (force-mode-line-update))
     ;; If optional verse specification go to that verse.
-    (when verse
-      (re-search-forward (concat " ?" (number-to-string verse)) nil t)))
+  (when verse 
+    (re-search-forward (concat " ?" (number-to-string verse)) nil t 1)))
 
 
 ;;;; Modules (Bible texts, commentaries)
@@ -1836,7 +1848,7 @@ If optional argument VERSE is supplied, set cursor at verse."
 ;;;; Bible Searching
 
 (defun bible--open-search (query searchmode module)
-  "Open a search buffer of QUERY using SEARCHMODE in module MODULE."
+  "Open a search buffer of QUERY using SEARCHMODE, getting values from BUFFER."
   (let ((results (string-trim (replace-regexp-in-string
                                "Entries .+?--" ""
                                (bible--diatheke-search query searchmode "plain" module)))))
@@ -1891,6 +1903,9 @@ If optional argument VERSE is supplied, set cursor at verse."
       (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body)))
     (goto-char (point-min))
     (save-excursion
+      ;; Highlight verse numbers.
+      (while (re-search-forward bible--verse-regexp nil t)
+        (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple")))
       ;; Remove module name from buffer.
       (while (re-search-forward (concat "^.*" module ".*$") nil t)
         (replace-match ""))