|
@@ -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)
|