Fred Gilham 1 неделя назад
Родитель
Сommit
9e36eabfff
1 измененных файлов с 59 добавлено и 45 удалено
  1. 59 45
      bible.el

+ 59 - 45
bible.el

@@ -220,12 +220,15 @@ See `bible--display-lemma-hebrew'."
   "List of buffers that are synchronized so that navigation in one applies 
   "List of buffers that are synchronized so that navigation in one applies 
 to all of them.")
 to all of them.")
 
 
+(defvar-local bible--synced-p nil
+  "Is this buffer syncronized?")
 
 
 (defvar bible-mode-line-format
 (defvar bible-mode-line-format
   '("%e" mode-line-front-space
   '("%e" mode-line-front-space
     mode-line-frame-identification mode-line-buffer-identification "   "
     mode-line-frame-identification mode-line-buffer-identification "   "
-    bible--current-book-name " " (:eval (number-to-string bible--current-chapter))
-    "  "
+    bible--current-book-name
+    " " (:eval (number-to-string bible--current-chapter))
+    "  " (:eval (if bible--synced-p "Sync" ""))
     "  " mode-line-modes mode-line-misc-info
     "  " mode-line-modes mode-line-misc-info
     mode-line-end-spaces)
     mode-line-end-spaces)
   "Mode line format for bible buffers.")
   "Mode line format for bible buffers.")
@@ -348,6 +351,8 @@ to all of them.")
     ("Rev" . "Revelation of John") ("Re" . "Revelation of John"))
     ("Rev" . "Revelation of John") ("Re" . "Revelation of John"))
   "A-list of abbreviations for Bible books.")
   "A-list of abbreviations for Bible books.")
 
 
+
+
 ;;;;; Book / chapter
 ;;;;; Book / chapter
 
 
 (defvar-local bible--current-book (assoc "Genesis" bible--books)
 (defvar-local bible--current-book (assoc "Genesis" bible--books)
@@ -366,6 +371,8 @@ to all of them.")
 (defvar-local bible-search-mode "phrase"
 (defvar-local bible-search-mode "phrase"
   "Search mode: either `lucene', `phrase', `regex' or `multiword'.")
   "Search mode: either `lucene', `phrase', `regex' or `multiword'.")
 
 
+
+
 (defvar bible-search-range nil)
 (defvar bible-search-range nil)
 
 
 ;;;;; Lexemes / morphemes
 ;;;;; Lexemes / morphemes
@@ -423,7 +430,9 @@ to all of them.")
             [menu-bar bible split-display]
             [menu-bar bible split-display]
             '("Split Display" . bible-split-display))
             '("Split Display" . bible-split-display))
 
 
-(define-key bible-map "S" 'bible-synchronize-display)
+(define-key bible-map "S" 'bible-toggle-buffer-sync)
+(define-key bible-map [menu-bar bible sync]
+	    '("Toggle Synchronize Buffer" . bible-toggle-buffer-sync))
 
 
 ;;;;; Navigation
 ;;;;; Navigation
 
 
@@ -674,36 +683,20 @@ specifies the module to use."
     (cl-pushnew (current-buffer) bible--text-buffers)
     (cl-pushnew (current-buffer) bible--text-buffers)
     (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
     (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
 
 
-(defun bible--navigate-to-next-chapter ()
+(defun bible-next-chapter ()
+  "Page to the next chapter for the active `bible' buffer and 
+for any synchronized buffers."
+  (interactive)
   (let* ((book-chapters (cdr bible--current-book))
   (let* ((book-chapters (cdr bible--current-book))
          (chapter (min book-chapters (1+ bible--current-chapter))))
          (chapter (min book-chapters (1+ bible--current-chapter))))
     (bible--set-location bible--current-book chapter)))
     (bible--set-location bible--current-book chapter)))
 
 
-(defun bible-next-chapter ()
-  "Page to the next chapter for the active `bible' buffer."
-  (interactive)
-  (bible--navigate-to-next-chapter)
-  (when bible--synced-buffers
-    (save-excursion
-      (dolist (buffer bible--synced-buffers)
-	(unless (eq buffer (current-buffer))
-	  (with-current-buffer buffer (bible--navigate-to-next-chapter)))))))
-
-(defun bible--navigate-to-previous-chapter ()
-  "Page to the previous chapter for the active `bible' buffer."
-  (interactive)
-  (bible--set-location bible--current-book (max 1 (1- bible--current-chapter))))
 
 
 (defun bible-previous-chapter ()
 (defun bible-previous-chapter ()
-  "Page to the previous chapter for the active `bible' buffer."
+  "Page to the previous chapter for the active `bible' buffer and
+for any synchronized buffers."
   (interactive)
   (interactive)
-  (bible--navigate-to-previous-chapter)
-  (when bible--synced-buffers
-    (save-excursion
-      (dolist (buffer bible--synced-buffers)
-	(unless (eq buffer (current-buffer))
-	  (with-current-buffer buffer 
-	    (bible--set-location bible--current-book (max 1 (1- bible--current-chapter)))))))))
+  (bible--set-location bible--current-book (max 1 (1- bible--current-chapter))))
 
 
 (defun bible-next-word ()
 (defun bible-next-word ()
   "Move forward a word, taking into account the relevant text properties."
   "Move forward a word, taking into account the relevant text properties."
@@ -735,10 +728,7 @@ specifies the module to use."
       (?1 (setq book-data (cons (concat "I" (substring book-data-string 1)) (cdr book-data))))
       (?1 (setq book-data (cons (concat "I" (substring book-data-string 1)) (cdr book-data))))
       (?2 (setq book-data (cons (concat "II" (substring book-data-string 1)) (cdr book-data))))
       (?2 (setq book-data (cons (concat "II" (substring book-data-string 1)) (cdr book-data))))
       (?3 (setq book-data (cons (concat "III" (substring book-data-string 1)) (cdr book-data)))))
       (?3 (setq book-data (cons (concat "III" (substring book-data-string 1)) (cdr book-data)))))
-    (setq-local bible--current-book book-data)
-    (setq-local bible--current-book-name (car book-data))
-    (setq-local bible--current-chapter chapter)
-    (bible--display)))
+    (bible--set-location book-data chapter)))
 
 
 (defun bible-select-chapter ()
 (defun bible-select-chapter ()
   "Ask user for a new chapter for the current `bible' buffer."
   "Ask user for a new chapter for the current `bible' buffer."
@@ -796,10 +786,18 @@ specifies the module to use."
   (other-window 1)
   (other-window 1)
   (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
   (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
 
 
-(defun bible-synchronize-display ()
-  "Copy the active `bible' buffer into a new buffer in another window."
+(defun bible-toggle-buffer-sync ()
+  "Either add or remove the current buffer from the
+`bible--synced-buffers' list."
   (interactive)
   (interactive)
-  (cl-pushnew (current-buffer) bible--synced-buffers))
+  (let ((buffer (current-buffer)))
+    (if bible--synced-p
+	(progn
+	  (setq bible--synced-buffers (cl-delete buffer bible--synced-buffers))
+	  (setq-local bible--synced-p nil))
+      (cl-pushnew buffer bible--synced-buffers)
+      (setq-local bible--synced-p t))
+    (force-mode-line-update)))
 
 
 (defun bible-search (query)
 (defun bible-search (query)
   "Search for a QUERY: a word or phrase.
   "Search for a QUERY: a word or phrase.
@@ -834,10 +832,7 @@ Create a new `bible' buffer positioned at the selected verse."
 (defun bible-search-mode-follow-xref ()
 (defun bible-search-mode-follow-xref ()
   "Follow the hovered verse in a bible term buffer.
   "Follow the hovered verse in a bible term buffer.
 Create a new `bible' buffer positioned at the specified verse.
 Create a new `bible' buffer positioned at the specified verse.
-Handle abbreviations from lexicon module (AbbottSmith)."
-;; HACK: We use the current module to avoid opening cans of worms
-;;       regarding OT/NT etc. If that module doesn't have that
-;;       verse...??? (FMG 5-Mar-2026)
+Handle abbreviations."
   (interactive)
   (interactive)
   (let* ((xref (get-text-property (point) 'xref))
   (let* ((xref (get-text-property (point) 'xref))
          (verse-ref (split-string xref))
          (verse-ref (split-string xref))
@@ -890,7 +885,9 @@ Handle abbreviations from lexicon module (AbbottSmith)."
 
 
 ;;;; Support (internal)
 ;;;; Support (internal)
 
 
-(defconst bible-diatheke-filter-options " afilmnsvw")
+;; Don't know how to get footnotes and scripture cross references yet.
+;;(defconst bible-diatheke-filter-options " afilmnsvw")
+(defconst bible-diatheke-filter-options " almnvw")
 
 
 (defun bible--exec-diatheke (query &optional filter format module)
 (defun bible--exec-diatheke (query &optional filter format module)
   "Execute `diatheke' with specified QUERY options.
   "Execute `diatheke' with specified QUERY options.
@@ -1225,8 +1222,9 @@ in buffer)."
       ;; REVIEW: Special case this. Some modules do this differently.
       ;; REVIEW: Special case this. Some modules do this differently.
       ;;         (FMG 5-Mar-2026)
       ;;         (FMG 5-Mar-2026)
       (when divinename
       (when divinename
-        (insert " ")
-        (bible-handle-divine-name item))
+	(just-one-space)
+        (bible-handle-divine-name item)
+	(just-one-space))
       ;; Red letter.
       ;; Red letter.
       (when (plist-get iproperties 'jesus)
       (when (plist-get iproperties 'jesus)
         (add-face-text-property refstart refend '(:foreground "red")))
         (add-face-text-property refstart refend '(:foreground "red")))
@@ -1359,7 +1357,6 @@ In processing subnodes, each case will prepend a space if it needs it."
 	       ;;       Maybe process these at some point? Include footnotes etc.
 	       ;;       Maybe process these at some point? Include footnotes etc.
                ;;       (FMG 5-Mar-2026)
                ;;       (FMG 5-Mar-2026)
                ;; ('node nil)
                ;; ('node nil)
-               ;; ('lb nil)
                ;; 'w is usual case.
                ;; 'w is usual case.
                ('w (insert " ") (bible--process-word subnode iproperties))
                ('w (insert " ") (bible--process-word subnode iproperties))
 	       ('title 
 	       ('title 
@@ -1390,8 +1387,13 @@ In processing subnodes, each case will prepend a space if it needs it."
 	       ;;         with all modules.
 	       ;;         with all modules.
 	       ('divinename (bible-handle-divine-name subnode))
 	       ('divinename (bible-handle-divine-name subnode))
                ;; Some modules use this for line breaks and such.
                ;; Some modules use this for line breaks and such.
-               ('milestone (when (equal (dom-attr subnode 'type) "line") (bible-new-line)))
+               ('milestone
+		(pcase (dom-attr subnode 'type)
+		("line" (bible-new-line))
+;;		("x-PN" (bible-new-line))
+		("x-p" (insert (dom-attr subnode 'marker) " "))))
                ('br (bible-new-line))
                ('br (bible-new-line))
+               ('lb (when (equal (dom-attr subnode 'type) "x-begin-paragraph") (bible-new-line)))
                ('div (when (or (equal (dom-attr subnode 'type) "paragraph")
                ('div (when (or (equal (dom-attr subnode 'type) "paragraph")
 			       (equal (dom-attr subnode 'type) "x-p"))
 			       (equal (dom-attr subnode 'type) "x-p"))
 		       (bible-new-line)))
 		       (bible-new-line)))
@@ -1433,8 +1435,10 @@ If optional argument VERSE is supplied, set cursor at verse."
         ;; Delete <Book Ch:> at beginning of verse, just leave verse number.
         ;; Delete <Book Ch:> at beginning of verse, just leave verse number.
         (while (re-search-forward search-string nil t)
         (while (re-search-forward search-string nil t)
           (replace-match "")
           (replace-match "")
+	  (bible-new-line)
           ;; Highlight verse number
           ;; Highlight verse number
-          (when (re-search-forward "^ *[0-9]+" nil t 1)
+	  ;;          (when (re-search-forward "^ *[0-9]+" nil t 1)
+	  (when (re-search-forward " *[0-9]+:" nil t 1)
             (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
             (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
     (save-excursion
     (save-excursion
       ;; Remove the module name from the buffer.
       ;; Remove the module name from the buffer.
@@ -1717,13 +1721,23 @@ This code is customized for the BDBGlosses_Strongs lexicon."
     (insert (bible--lookup-lemma-greek lemma))
     (insert (bible--lookup-lemma-greek lemma))
     (bible--fixup-lexicon-display 'greek)))
     (bible--fixup-lexicon-display 'greek)))
 
 
-(defun bible--set-location (book chapter &optional verse)
-  "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
+(defun bible--do-set-location (book chapter &optional verse)
   (setq-local bible--current-book book)
   (setq-local bible--current-book book)
   (setq-local bible--current-book-name (car book))
   (setq-local bible--current-book-name (car book))
   (setq-local bible--current-chapter chapter)
   (setq-local bible--current-chapter chapter)
   (bible--display bible-text verse))
   (bible--display bible-text verse))
 
 
+(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)
+    (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))))))))
+
 ;;;; Utilities
 ;;;; Utilities
 
 
 (defun bible--remove-module-name (module-name string)
 (defun bible--remove-module-name (module-name string)