Просмотр исходного кода

Fix commentary/text distinction

Fred Gilham 6 дней назад
Родитель
Сommit
ab614e0e2e
1 измененных файлов с 88 добавлено и 30 удалено
  1. 88 30
      bible.el

+ 88 - 30
bible.el

@@ -221,7 +221,7 @@ See `bible--display-lemma-hebrew'."
 (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-text
+;;    bible-text
     "  "
     "  "
     bible--current-book-name
     bible--current-book-name
     " "  (:eval (number-to-string bible--current-chapter))
     " "  (:eval (number-to-string bible--current-chapter))
@@ -459,8 +459,12 @@ See `bible--display-lemma-hebrew'."
 
 
 ;;;;; Module choice keymaps.
 ;;;;; Module choice keymaps.
 (defconst bible-text-map (make-keymap))
 (defconst bible-text-map (make-keymap))
-(define-key bible-text-map [mouse-1] 'bible-pick-module)
-(define-key bible-text-map (kbd "RET") 'bible-pick-module)
+(define-key bible-text-map [mouse-1] 'bible-pick-text)
+(define-key bible-text-map (kbd "RET") 'bible-pick-text)
+
+(defconst bible-commentary-map (make-keymap))
+(define-key bible-commentary-map [mouse-1] 'bible-pick-commentary)
+(define-key bible-commentary-map (kbd "RET") 'bible-pick-commentary)
 
 
 
 
 ;;;; Variable definitions
 ;;;; Variable definitions
@@ -745,17 +749,18 @@ Mostly in Psalms, like `Of David' or the like.")
 
 
 ;;;;; Commands (interactive)
 ;;;;; Commands (interactive)
 
 
-(defun bible-open (&optional book-name chapter verse module)
+(defun bible-open (&optional buffer book-name chapter verse module)
   "Create and open a `bible' buffer.
   "Create and open a `bible' buffer.
 Optional arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the
 Optional arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the
 starting verse reference for the buffer. If no optional location
 starting verse reference for the buffer. If no optional location
 arguments are supplied, Genesis 1:1 is used. Optional argument MODULE
 arguments are supplied, Genesis 1:1 is used. Optional argument MODULE
 specifies the module to use."
 specifies the module to use."
   (interactive)
   (interactive)
-  (with-current-buffer (get-buffer-create (generate-new-buffer-name "*bible*"))
+  (with-current-buffer (or buffer (get-buffer-create (generate-new-buffer-name "*bible*")))
     (bible)
     (bible)
     (when module (setq-default bible-text module))
     (when module (setq-default bible-text module))
     (setq-local bible-text (default-value 'bible-text))
     (setq-local bible-text (default-value 'bible-text))
+    (setq-local mode-name (concat "Text " bible-text))
     (bible--set-location
     (bible--set-location
      (assoc (or book-name "Genesis") bible--books)
      (assoc (or book-name "Genesis") bible--books)
      (or chapter 1)
      (or chapter 1)
@@ -763,6 +768,28 @@ 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))))
 
 
+(defvar-local associated-buffer nil)
+(defun commentary-open (&optional module book-name chapter verse)
+  "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."
+  (interactive)
+  (let ((old-buffer (current-buffer)))
+    (with-current-buffer (get-buffer-create (generate-new-buffer-name "*commentary*"))
+      (bible)
+      (when module (setq-default bible-commentary module))
+      (setq-local associated-buffer old-buffer)
+      (setq-local bible-text (default-value 'bible-commentary))
+      (setq-local mode-name (concat "Commentary " bible-text))
+      (bible--set-location
+       (assoc (or book-name "Genesis") bible--books)
+       (or chapter 1)
+       verse)
+      (cl-pushnew (current-buffer) bible--commentary-buffers)
+      (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer)))))
+
 ;;;;;; Navigation
 ;;;;;; Navigation
 
 
 (defun bible--do-set-location (book chapter &optional verse)
 (defun bible--do-set-location (book chapter &optional verse)
@@ -844,11 +871,19 @@ for any synchronized buffers."
 ;;;;;; Select modules
 ;;;;;; Select modules
 
 
 ;; Choose a module.
 ;; Choose a module.
-(defun bible-pick-module ()
-  "Keymap action function---select module that the user chooses."
+(defun bible-pick-text ()
+  "Keymap action function---select text that the user chooses."
   (interactive)
   (interactive)
   (let ((item (get-text-property (point) 'module)))
   (let ((item (get-text-property (point) 'module)))
-    (bible-open bible--current-book-name bible--current-chapter 1 item)))
+    (bible-open nil bible--current-book-name bible--current-chapter 1 item)))
+
+(defun bible-pick-commentary (&optional module)
+  "Keymap action function---select commentary that the user chooses.
+Use optional argument MODULE as commentary if given."
+  (interactive)
+  (let ((item (or module (get-text-property (point) 'module))))
+    (setq-local bible-commentary item)
+    (commentary-open item bible--current-book-name bible--current-chapter 1)))
 
 
 (defun bible-select-text ()
 (defun bible-select-text ()
   "Ask user for a new text module for the current `bible' buffer."
   "Ask user for a new text module for the current `bible' buffer."
@@ -860,12 +895,12 @@ for any synchronized buffers."
       (bible--display))))
       (bible--display))))
 
 
 (defun bible-select-commentary ()
 (defun bible-select-commentary ()
-  "Ask user for a new text module for the current `bible' buffer."
+  "Ask user for a new commentary module for the current `bible' buffer."
   (interactive)
   (interactive)
   (let ((commentary (completing-read "Commentary: " bible--commentaries)))
   (let ((commentary (completing-read "Commentary: " bible--commentaries)))
     (unless (string= commentary "")
     (unless (string= commentary "")
-      (setq-local bible-text commentary)
-      (bible--display))))
+      (setq-local bible-commentary commentary)
+      (bible-pick-commentary bible-commentary))))
 
 
 ;;;;;; Toggles
 ;;;;;; Toggles
 
 
@@ -900,7 +935,7 @@ for any synchronized buffers."
   (split-window-right)
   (split-window-right)
   (balance-windows)
   (balance-windows)
   (other-window 1)
   (other-window 1)
-  (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
+  (bible-open nil bible--current-book-name bible--current-chapter 1 bible-text))
 
 
 ;;;;;; Search helpers
 ;;;;;; Search helpers
 
 
@@ -938,21 +973,22 @@ Create a new `bible' buffer positioned at the selected verse."
       (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
       (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
       (string-match ":[0-9]?[0-9]?[0-9]?" text)
       (string-match ":[0-9]?[0-9]?[0-9]?" text)
       (setq verse (substring (match-string 0 text) 1))
       (setq verse (substring (match-string 0 text) 1))
-      (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse)) bible-text)))
+      (bible-open associated-buffer 
+                  (string-trim book)
+                  (string-to-number chapter)
+                  (string-to-number verse)
+                  bible-text))))
 
 
 (defun bible-follow-xref ()
 (defun bible-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."
 Handle abbreviations."
   (interactive)
   (interactive)
-;;  (message "Following xref.")
   (let ((xref (get-text-property (point) 'xref)))
   (let ((xref (get-text-property (point) 'xref)))
     (when xref
     (when xref
       (let ((verse-ref (split-string xref))
       (let ((verse-ref (split-string xref))
             book-abbrev
             book-abbrev
             chapter-verse)
             chapter-verse)
-;;        (message "xref: %s" xref)
-;;        (message "Verse-ref: %s" verse-ref)
         (cond ((= (length verse-ref) 2) ; Mat 5 or the like
         (cond ((= (length verse-ref) 2) ; Mat 5 or the like
                (setq book-abbrev (car verse-ref)
                (setq book-abbrev (car verse-ref)
                      chapter-verse (split-string (cadr verse-ref) ":")))
                      chapter-verse (split-string (cadr verse-ref) ":")))
@@ -960,10 +996,19 @@ Handle abbreviations."
                (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
                (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
                      chapter-verse (split-string (caddr verse-ref) ":"))))
                      chapter-verse (split-string (caddr verse-ref) ":"))))
         ;; Use book abbreviation if present or try whatever is in 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 nil nil #'string-equal-ignore-case) (car verse-ref)))
+        (let ((book (or (alist-get book-abbrev
+                                   bible--book-name-abbreviations
+                                   nil
+                                   nil
+                                   #'string-equal-ignore-case)
+                        (car verse-ref)))
               (chapter (car chapter-verse))
               (chapter (car chapter-verse))
               (verse (cadr chapter-verse)))
               (verse (cadr chapter-verse)))
-          (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse) (default-value 'bible-text)))))))
+          (bible-open associated-buffer 
+                      (string-trim book)
+                      (string-to-number chapter)
+                      (string-to-number verse)
+                      (default-value 'bible-text)))))))
 
 
 
 
 ;;;;;; User visible actions.
 ;;;;;; User visible actions.
@@ -1378,17 +1423,14 @@ stored in `bible-chapter-title'."
 (defvar-local bible-current-xref-book nil)
 (defvar-local bible-current-xref-book nil)
 (defvar-local bible-current-xref-chapter nil)
 (defvar-local bible-current-xref-chapter nil)
 (defun bible--insert-xref (node)
 (defun bible--insert-xref (node)
-  "Insert a cross reference specified by NODE."
+  "Insert a cross reference specified by NODE.
+This format is used by the NETnote module."
   ;; HACK: What a mess! There are still some broken edge cases! (FMG 29-Mar-2026)
   ;; HACK: What a mess! There are still some broken edge cases! (FMG 29-Mar-2026)
   (let* ((refs-text (bible-dom-text node))
   (let* ((refs-text (bible-dom-text node))
          (refs (split-string refs-text "," t " ")))
          (refs (split-string refs-text "," t " ")))
-;;    (message "Got refs |%s|" refs)
     (dolist (ref refs)
     (dolist (ref refs)
-;;      (message "Got ref %s" ref) 
       (let ((a-ref (split-string ref ";" t " ")))
       (let ((a-ref (split-string ref ";" t " ")))
-;;        (message "Got a-ref %s" a-ref)
         (dolist (b-ref a-ref)
         (dolist (b-ref a-ref)
-;;          (message "Got b-ref %s" b-ref)
           ;; b-ref is an individual reference.
           ;; b-ref is an individual reference.
           ;; At this point b-ref will, we hope, look like one of the following:
           ;; At this point b-ref will, we hope, look like one of the following:
           ;; <book> <chapter>:<verse> (or maybe <book> <chapter>)
           ;; <book> <chapter>:<verse> (or maybe <book> <chapter>)
@@ -1398,16 +1440,12 @@ stored in `bible-chapter-title'."
           ;; We ignore verse ranges and hope for the best (it seems to do the right thing).
           ;; We ignore verse ranges and hope for the best (it seems to do the right thing).
           (let ((set-chapter-p nil))
           (let ((set-chapter-p nil))
             (when (string-match ".* " b-ref)
             (when (string-match ".* " b-ref)
-              (setq-local bible-current-xref-book (match-string 0 b-ref))
-;;              (message "Setting book to |%s|" bible-current-xref-book)
-              )
+              (setq-local bible-current-xref-book (match-string 0 b-ref)))
             (when (string-match "[0-9]*:" b-ref)
             (when (string-match "[0-9]*:" b-ref)
               (setq-local bible-current-xref-chapter (string-trim (substring (match-string 0 b-ref) 0 (1- (length (match-string 0 b-ref))))))
               (setq-local bible-current-xref-chapter (string-trim (substring (match-string 0 b-ref) 0 (1- (length (match-string 0 b-ref))))))
-;;              (message "Setting chapter to |%s|" bible-current-xref-chapter)
               (setq set-chapter-p t))
               (setq set-chapter-p t))
             (let* ((match (string-match "[0-9]*" b-ref (if set-chapter-p (match-end 0) 0)))
             (let* ((match (string-match "[0-9]*" b-ref (if set-chapter-p (match-end 0) 0)))
                    (verse (string-trim (substring b-ref match (match-end 0)))))
                    (verse (string-trim (substring b-ref match (match-end 0)))))
-;;              (message "verse is |%s|" verse)
               (just-one-space)
               (just-one-space)
               (let ((start (point))
               (let ((start (point))
                     (the-ref (concat bible-current-xref-book bible-current-xref-chapter)))
                     (the-ref (concat bible-current-xref-book bible-current-xref-chapter)))
@@ -1418,6 +1456,23 @@ stored in `bible-chapter-title'."
                 (put-text-property start (point) 'help-echo (concat "Go to " the-ref))
                 (put-text-property start (point) 'help-echo (concat "Go to " the-ref))
                 (add-face-text-property start (point) '(:foreground "blue"))))))))))
                 (add-face-text-property start (point) '(:foreground "blue"))))))))))
 
 
+(defun bible--insert-osis-xref (node)
+  "Insert a cross reference specified by NODE.
+The node should have the `osisref' attribute."
+  (let* ((ref-text (bible-dom-text node))
+         (ref-ref (dom-attr node 'osisref))
+         (ref-split (split-string ref-ref "[.]" t " "))
+         (ref-book (cl-first ref-split))
+         (ref-chapter (cl-second ref-split))
+         (ref-verse (cl-third ref-split))
+         (the-ref (concat ref-book " " ref-chapter ":" ref-verse)))
+    (just-one-space)
+    (let ((start (point)))
+      (insert ref-text)
+      (put-text-property start (point) 'xref the-ref)
+      (put-text-property start (point) 'keymap bible-term-mode-map)
+      (put-text-property start (point) 'help-echo (concat "Go to " the-ref))
+      (add-face-text-property start (point) '(:foreground "blue")))))
 
 
 (defun bible--insert-domnode-recursive (node &optional iproperties)
 (defun bible--insert-domnode-recursive (node &optional iproperties)
   "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
   "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
@@ -1486,7 +1541,10 @@ In processing subnodes, each case will prepend a space if it needs it."
                                (equal (dom-attr subnode 'type) "x-p"))
                                (equal (dom-attr subnode 'type) "x-p"))
                        (bible-new-line)))
                        (bible-new-line)))
                ;; For commentaries and the like.
                ;; For commentaries and the like.
-               ((or 'scripref 'reference) (bible--insert-xref subnode))
+               ;; This is used by the NETnote module.
+               ('scripref (bible--insert-xref subnode))
+               ;; This is used by many commentaries.
+               ('reference (bible--insert-osis-xref subnode))
                ;; Various text properties---ignore for now. REVIEW: (FMG 26-Mar-2026)
                ;; Various text properties---ignore for now. REVIEW: (FMG 26-Mar-2026)
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ;; Word inserted by translation, not in original, give visual indication.
                ;; Word inserted by translation, not in original, give visual indication.
@@ -1664,7 +1722,7 @@ If optional argument VERSE is supplied, set cursor at verse."
                        'face 'bold
                        'face 'bold
                        'module name
                        'module name
                        'help-echo (concat "Select " name)
                        'help-echo (concat "Select " name)
-                       'keymap bible-text-map))
+                       'keymap bible-commentary-map))
           (move-to-tab-stop)
           (move-to-tab-stop)
           (insert (format "%s\n" description)))))
           (insert (format "%s\n" description)))))
     (goto-char (point-min))
     (goto-char (point-min))