Browse Source

Start fix of chapter title issue for Psalm 119

Fred Gilham 3 weeks ago
parent
commit
565a0b4597
1 changed files with 30 additions and 24 deletions
  1. 30 24
      bible.el

+ 30 - 24
bible.el

@@ -1193,15 +1193,18 @@ in buffer)."
   (unless (= (current-column) 0)
     (insert "\n")))
 
-(defun bible--insert-domnode-recursive (node &optional iproperties notitle)
+
+
+(defun bible--insert-domnode-recursive (node &optional iproperties)
   "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
 Inserts resulting text into active buffer with properties specified in
-IPROPERTIES.  If NOTITLE is true, don't render title headings.
+IPROPERTIES.
 In processing subnodes, each case will prepend a space if it needs it."
   (when (and bible-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
     ;; For red-letter display.
     (setq iproperties (plist-put iproperties 'jesus t)))
   (dolist (subnode (dom-children node))
+
     (cond ((null subnode) nil)
           ((stringp subnode)
            ;; Red letter
@@ -1216,6 +1219,25 @@ In processing subnodes, each case will prepend a space if it needs it."
                ;;       (FMG 5-Mar-2026)
                ;; ('node nil)
                ;; ('lb nil)
+	       ;; We have to handle the title first to make sure it
+	       ;; gets put in the right place. This mess is to deal
+	       ;; with the possibility that the title might change in
+	       ;; the middle of the chapter. I'm talking about YOU,
+	       ;; Psalm 119.
+	       ('title
+		(unless (equal subnode bible-chapter-title)
+		  (unless (= (point) (point-min))
+		    (forward-line -1)
+		    (bible-new-line))
+		  (setq-local bible-chapter-title subnode)
+		  (let ((title-text (bible-dom-texts bible-chapter-title))
+			(refstart (point))
+			refend)
+		    (when (stringp title-text)
+		      (setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
+		      (insert title-text "\n")
+		      (setq refend (point))
+		      (put-text-property refstart refend 'face 'bold)))))
                ;; 'w is usual case.
                ('w (insert " ") (bible--process-word subnode iproperties))
                ;; Font tag should be ignored, treat as if 'w
@@ -1231,8 +1253,9 @@ In processing subnodes, each case will prepend a space if it needs it."
                   (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
                ;; 'q is used for red letter.
                ;; NASB Module uses 'seg to indicate OT quotations (and others?).
-               ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties notitle))
-               ('title (unless notitle (setq bible-chapter-title subnode) (bible-new-line)))
+	       ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties))
+;;               ('title (setq bible-chapter-title subnode) (bible-new-line))
+;;	       (setq bible-chapter-title subnode) (bible-new-line))
                ;; These tags appear in ESV modules (and maybe others?)
                ;; REVIEW: Is this right? (FMG 5-Mar-2026)
                ('l
@@ -1268,7 +1291,7 @@ In processing subnodes, each case will prepend a space if it needs it."
                       (put-text-property start end 'help-echo (concat "Go to " word " (doesn't work yet)"))
                       (add-face-text-property start end '(:foreground "blue"))))))
                ;; Various text properties---ignore for now
-               ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties notitle))
+               ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ;; Word inserted by translation, not in original, give visual indication.
                ('transchange
                 (let ((word (bible-dom-text subnode)))
@@ -1277,14 +1300,12 @@ In processing subnodes, each case will prepend a space if it needs it."
                       (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
                     (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
 
-
 (defun bible--display (&optional module verse)
   "Render a page of Bible text.
 If optional argument MODULE is supplied, use that module for display.
 If optional argument VERSE is supplied, set cursor at verse."
   (when module (setq-local bible-module module))
   (let ((buffer-read-only nil)
-        (bible-chapter-title nil)
         (bible-has-lexemes nil)
         (bible-has-morphemes nil))
     (erase-buffer)
@@ -1295,7 +1316,7 @@ If optional argument VERSE is supplied, set cursor at verse."
       (unless bible-debugme        ; If this is true, display the XML.
         (erase-buffer)
         ;; Looking for the "body" tag in the DOM node.
-        (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil)
         (goto-char (point-min))))
     (save-excursion
       (let ((search-string (concat " *" (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
@@ -1318,21 +1339,6 @@ If optional argument VERSE is supplied, set cursor at verse."
 	(replace-match "LORD's")
 	(add-face-text-property (1- (point)) (- (point) 5) 'bold)))
     (save-excursion
-      ;; Deal with chapter titles (i.e. in Psalms)
-      ;; TODO: N.B. This won't change a title inside a chapter, and so
-      ;;       it doesn't work with Psalm 119 where the acrostic
-      ;;       letters get printed as titles. (FMG 5-Mar-2026)
-      (when bible-chapter-title ; This gets set in bible--insert-domnode-recursive.
-        (let ((title-text (bible-dom-texts bible-chapter-title))
-              (refstart (point-min))
-              refend)
-          (when (stringp title-text)
-            ;; Clear out XML stuff.
-            (setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
-            (insert title-text "\n")
-            (setq refend (point))
-            (put-text-property refstart refend 'face 'bold))))
-      ;; Get rid of spurious spaces.
       (format-replace-strings '(("." . ". ")
                                 ("," . ", ")
                                 (";" . "; ")
@@ -1460,7 +1466,7 @@ If optional argument VERSE is supplied, set cursor at verse."
       (insert (bible--exec-diatheke query-verses nil nil module)))
     (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
       (erase-buffer)
-      (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil))
+      (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil))
     (goto-char (point-min))
     (save-excursion
       (while (re-search-forward (concat "^.*" module) nil t)