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)
   (unless (= (current-column) 0)
     (insert "\n")))
     (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'.
   "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
 Inserts resulting text into active buffer with properties specified in
 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."
 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"))
   (when (and bible-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
     ;; For red-letter display.
     ;; For red-letter display.
     (setq iproperties (plist-put iproperties 'jesus t)))
     (setq iproperties (plist-put iproperties 'jesus t)))
   (dolist (subnode (dom-children node))
   (dolist (subnode (dom-children node))
+
     (cond ((null subnode) nil)
     (cond ((null subnode) nil)
           ((stringp subnode)
           ((stringp subnode)
            ;; Red letter
            ;; Red letter
@@ -1216,6 +1219,25 @@ In processing subnodes, each case will prepend a space if it needs it."
                ;;       (FMG 5-Mar-2026)
                ;;       (FMG 5-Mar-2026)
                ;; ('node nil)
                ;; ('node nil)
                ;; ('lb 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 is usual case.
                ('w (insert " ") (bible--process-word subnode iproperties))
                ('w (insert " ") (bible--process-word subnode iproperties))
                ;; Font tag should be ignored, treat as if 'w
                ;; 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"))))
                   (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
                ;; 'q is used for red letter.
                ;; 'q is used for red letter.
                ;; NASB Module uses 'seg to indicate OT quotations (and others?).
                ;; 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?)
                ;; These tags appear in ESV modules (and maybe others?)
                ;; REVIEW: Is this right? (FMG 5-Mar-2026)
                ;; REVIEW: Is this right? (FMG 5-Mar-2026)
                ('l
                ('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)"))
                       (put-text-property start end 'help-echo (concat "Go to " word " (doesn't work yet)"))
                       (add-face-text-property start end '(:foreground "blue"))))))
                       (add-face-text-property start end '(:foreground "blue"))))))
                ;; Various text properties---ignore for now
                ;; 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.
                ;; Word inserted by translation, not in original, give visual indication.
                ('transchange
                ('transchange
                 (let ((word (bible-dom-text subnode)))
                 (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 "salmon"))
                     (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
                     (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
 
 
-
 (defun bible--display (&optional module verse)
 (defun bible--display (&optional module verse)
   "Render a page of Bible text.
   "Render a page of Bible text.
 If optional argument MODULE is supplied, use that module for display.
 If optional argument MODULE is supplied, use that module for display.
 If optional argument VERSE is supplied, set cursor at verse."
 If optional argument VERSE is supplied, set cursor at verse."
   (when module (setq-local bible-module module))
   (when module (setq-local bible-module module))
   (let ((buffer-read-only nil)
   (let ((buffer-read-only nil)
-        (bible-chapter-title nil)
         (bible-has-lexemes nil)
         (bible-has-lexemes nil)
         (bible-has-morphemes nil))
         (bible-has-morphemes nil))
     (erase-buffer)
     (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.
       (unless bible-debugme        ; If this is true, display the XML.
         (erase-buffer)
         (erase-buffer)
         ;; Looking for the "body" tag in the DOM node.
         ;; 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))))
         (goto-char (point-min))))
     (save-excursion
     (save-excursion
       (let ((search-string (concat " *" (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
       (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")
 	(replace-match "LORD's")
 	(add-face-text-property (1- (point)) (- (point) 5) 'bold)))
 	(add-face-text-property (1- (point)) (- (point) 5) 'bold)))
     (save-excursion
     (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 '(("." . ". ")
       (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)))
       (insert (bible--exec-diatheke query-verses nil nil module)))
     (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
     (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
       (erase-buffer)
       (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))
     (goto-char (point-min))
     (save-excursion
     (save-excursion
       (while (re-search-forward (concat "^.*" module) nil t)
       (while (re-search-forward (concat "^.*" module) nil t)