Parcourir la source

Fix commentary/text distinction

Fred Gilham il y a 6 jours
Parent
commit
ab614e0e2e
1 fichiers modifiés avec 88 ajouts et 30 suppressions
  1. 88 30
      bible.el

+ 88 - 30
bible.el

@@ -221,7 +221,7 @@ See `bible--display-lemma-hebrew'."
 (defvar bible-mode-line-format
   '("%e" mode-line-front-space
     mode-line-frame-identification mode-line-buffer-identification "   "
-    bible-text
+;;    bible-text
     "  "
     bible--current-book-name
     " "  (:eval (number-to-string bible--current-chapter))
@@ -459,8 +459,12 @@ See `bible--display-lemma-hebrew'."
 
 ;;;;; Module choice keymaps.
 (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
@@ -745,17 +749,18 @@ Mostly in Psalms, like `Of David' or the like.")
 
 ;;;;; 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.
 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. Optional argument MODULE
 specifies the module to use."
   (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)
     (when module (setq-default bible-text module))
     (setq-local bible-text (default-value 'bible-text))
+    (setq-local mode-name (concat "Text " bible-text))
     (bible--set-location
      (assoc (or book-name "Genesis") bible--books)
      (or chapter 1)
@@ -763,6 +768,28 @@ specifies the module to use."
     (cl-pushnew (current-buffer) bible--text-buffers)
     (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
 
 (defun bible--do-set-location (book chapter &optional verse)
@@ -844,11 +871,19 @@ for any synchronized buffers."
 ;;;;;; Select modules
 
 ;; 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)
   (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 ()
   "Ask user for a new text module for the current `bible' buffer."
@@ -860,12 +895,12 @@ for any synchronized buffers."
       (bible--display))))
 
 (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)
   (let ((commentary (completing-read "Commentary: " bible--commentaries)))
     (unless (string= commentary "")
-      (setq-local bible-text commentary)
-      (bible--display))))
+      (setq-local bible-commentary commentary)
+      (bible-pick-commentary bible-commentary))))
 
 ;;;;;; Toggles
 
@@ -900,7 +935,7 @@ for any synchronized buffers."
   (split-window-right)
   (balance-windows)
   (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
 
@@ -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)))))
       (string-match ":[0-9]?[0-9]?[0-9]?" text)
       (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 ()
   "Follow the hovered verse in a bible term buffer.
 Create a new `bible' buffer positioned at the specified verse.
 Handle abbreviations."
   (interactive)
-;;  (message "Following xref.")
   (let ((xref (get-text-property (point) 'xref)))
     (when xref
       (let ((verse-ref (split-string xref))
             book-abbrev
             chapter-verse)
-;;        (message "xref: %s" xref)
-;;        (message "Verse-ref: %s" verse-ref)
         (cond ((= (length verse-ref) 2) ; Mat 5 or the like
                (setq book-abbrev (car 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))
                      chapter-verse (split-string (caddr 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))
               (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.
@@ -1378,17 +1423,14 @@ stored in `bible-chapter-title'."
 (defvar-local bible-current-xref-book nil)
 (defvar-local bible-current-xref-chapter nil)
 (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)
   (let* ((refs-text (bible-dom-text node))
          (refs (split-string refs-text "," t " ")))
-;;    (message "Got refs |%s|" refs)
     (dolist (ref refs)
-;;      (message "Got ref %s" ref) 
       (let ((a-ref (split-string ref ";" t " ")))
-;;        (message "Got a-ref %s" a-ref)
         (dolist (b-ref a-ref)
-;;          (message "Got b-ref %s" b-ref)
           ;; b-ref is an individual reference.
           ;; At this point b-ref will, we hope, look like one of the following:
           ;; <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).
           (let ((set-chapter-p nil))
             (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)
               (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))
             (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)))))
-;;              (message "verse is |%s|" verse)
               (just-one-space)
               (let ((start (point))
                     (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))
                 (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)
   "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"))
                        (bible-new-line)))
                ;; 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)
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ;; 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
                        'module name
                        'help-echo (concat "Select " name)
-                       'keymap bible-text-map))
+                       'keymap bible-commentary-map))
           (move-to-tab-stop)
           (insert (format "%s\n" description)))))
     (goto-char (point-min))