|
|
@@ -487,8 +487,6 @@ to all of them.")
|
|
|
(define-key bible-search-mode-map "w" 'bible-toggle-word-study)
|
|
|
(define-key bible-search-mode-map "n" 'bible-next-search-item)
|
|
|
(define-key bible-search-mode-map "p" 'bible-previous-search-item)
|
|
|
-;;(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
|
|
|
-;;(define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-verse)
|
|
|
(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-xref)
|
|
|
(define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-xref)
|
|
|
|
|
|
@@ -683,6 +681,8 @@ specifies the module to use."
|
|
|
(cl-pushnew (current-buffer) bible--text-buffers)
|
|
|
(set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
|
|
|
|
|
|
+;;;;;; Navigation
|
|
|
+
|
|
|
(defun bible-next-chapter ()
|
|
|
"Page to the next chapter for the active `bible' buffer and
|
|
|
for any synchronized buffers."
|
|
|
@@ -691,7 +691,6 @@ for any synchronized buffers."
|
|
|
(chapter (min book-chapters (1+ bible--current-chapter))))
|
|
|
(bible--set-location bible--current-book chapter)))
|
|
|
|
|
|
-
|
|
|
(defun bible-previous-chapter ()
|
|
|
"Page to the previous chapter for the active `bible' buffer and
|
|
|
for any synchronized buffers."
|
|
|
@@ -714,6 +713,8 @@ for any synchronized buffers."
|
|
|
(when previous-change
|
|
|
(goto-char (prop-match-beginning previous-change))))))
|
|
|
|
|
|
+;;;;;; Select Location
|
|
|
+
|
|
|
(defun bible-select-book ()
|
|
|
"Ask user for a new book and chapter for the current `bible' buffer."
|
|
|
(interactive)
|
|
|
@@ -741,13 +742,14 @@ for any synchronized buffers."
|
|
|
(when chapter
|
|
|
(bible--set-location bible--current-book chapter))))
|
|
|
|
|
|
-(defun bible-set-search-range ()
|
|
|
- "Ask user for a new text module for the current `bible' buffer."
|
|
|
+;;;;;; Select modules
|
|
|
+
|
|
|
+;; Choose a module.
|
|
|
+(defun bible-pick-module ()
|
|
|
+ "Keymap action function---select module that the user chooses."
|
|
|
(interactive)
|
|
|
- (let ((range (read-string "Range (<return> to clear): ")))
|
|
|
- (if (string-equal range "")
|
|
|
- (setq bible-search-range nil)
|
|
|
- (setq bible-search-range range))))
|
|
|
+ (let ((item (get-text-property (point) 'module)))
|
|
|
+ (bible-open bible--current-book-name bible--current-chapter 1 item)))
|
|
|
|
|
|
(defun bible-select-text ()
|
|
|
"Ask user for a new text module for the current `bible' buffer."
|
|
|
@@ -766,6 +768,8 @@ for any synchronized buffers."
|
|
|
(setq-local bible-text commentary)
|
|
|
(bible--display))))
|
|
|
|
|
|
+;;;;;; Toggles
|
|
|
+
|
|
|
(defun bible-toggle-word-study ()
|
|
|
"Toggle the inclusion of word study for the active `bible' buffer."
|
|
|
(interactive)
|
|
|
@@ -778,14 +782,6 @@ for any synchronized buffers."
|
|
|
(setq bible-red-letter-enabled (not bible-red-letter-enabled))
|
|
|
(bible--display))
|
|
|
|
|
|
-(defun bible-split-display ()
|
|
|
- "Copy the active `bible' buffer into a new buffer in another window."
|
|
|
- (interactive)
|
|
|
- (split-window-right)
|
|
|
- (balance-windows)
|
|
|
- (other-window 1)
|
|
|
- (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
|
|
|
-
|
|
|
(defun bible-toggle-buffer-sync ()
|
|
|
"Either add or remove the current buffer from the
|
|
|
`bible--synced-buffers' list."
|
|
|
@@ -799,6 +795,24 @@ for any synchronized buffers."
|
|
|
(setq-local bible--synced-p t))
|
|
|
(force-mode-line-update)))
|
|
|
|
|
|
+(defun bible-split-display ()
|
|
|
+ "Copy the active `bible' buffer into a new buffer in another window."
|
|
|
+ (interactive)
|
|
|
+ (split-window-right)
|
|
|
+ (balance-windows)
|
|
|
+ (other-window 1)
|
|
|
+ (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
|
|
|
+
|
|
|
+;;;;;; Search helpers
|
|
|
+
|
|
|
+(defun bible-set-search-range ()
|
|
|
+ "Ask user for a new text module for the current `bible' buffer."
|
|
|
+ (interactive)
|
|
|
+ (let ((range (read-string "Range (<return> to clear): ")))
|
|
|
+ (if (string-equal range "")
|
|
|
+ (setq bible-search-range nil)
|
|
|
+ (setq bible-search-range range))))
|
|
|
+
|
|
|
(defun bible-search (query)
|
|
|
"Search for a QUERY: a word or phrase.
|
|
|
Asks the user for type of search: either `lucene', `phrase', `regex'
|
|
|
@@ -810,25 +824,6 @@ or `multiword'. `lucene' is the default search.
|
|
|
(let ((searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
|
|
|
(bible--open-search query searchmode (buffer-local-value 'bible-text (current-buffer))))))
|
|
|
|
|
|
-(defun bible-search-mode-follow-verse ()
|
|
|
- "Follow the hovered verse in a `bible-search-mode' buffer.
|
|
|
-Create a new `bible' buffer positioned at the selected verse."
|
|
|
- (interactive)
|
|
|
- (let* ((text (thing-at-point 'line t))
|
|
|
- book
|
|
|
- chapter
|
|
|
- verse)
|
|
|
- (string-match bible--verse-regexp text)
|
|
|
- (setq text (match-string 0 text))
|
|
|
- (message "Text match is %s" text)
|
|
|
- (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
|
|
|
- (setq book (match-string 0 text))
|
|
|
- (string-match "[0-9]?[0-9]?[0-9]?:" text)
|
|
|
- (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))
|
|
|
-
|
|
|
(defun bible-search-mode-follow-xref ()
|
|
|
"Follow the hovered verse in a bible term buffer.
|
|
|
Create a new `bible' buffer positioned at the specified verse.
|
|
|
@@ -851,6 +846,9 @@ Handle abbreviations."
|
|
|
(verse (cadr chapter-verse)))
|
|
|
(bible-open (string-trim book) (string-to-number chapter) (string-to-number verse) (default-value 'bible-text)))))
|
|
|
|
|
|
+
|
|
|
+;;;;;; User visible actions.
|
|
|
+
|
|
|
;; These can be called interactively if you know the Strong's number
|
|
|
;; you want to look up.
|
|
|
|
|
|
@@ -876,14 +874,8 @@ Handle abbreviations."
|
|
|
(args (list bible-sword-query nil (current-buffer) t "-b" bible-text "-f" "plain" "-k" query)))
|
|
|
(apply #'call-process args)))
|
|
|
|
|
|
-;; Choose a Bible text.
|
|
|
-(defun bible-pick-module ()
|
|
|
- "Keymap action function---select module user chooses."
|
|
|
- (interactive)
|
|
|
- (let ((item (get-text-property (point) 'module)))
|
|
|
- (bible-open bible--current-book-name bible--current-chapter 1 item)))
|
|
|
|
|
|
-;;;; Support (internal)
|
|
|
+;;;;;; Support (internal)
|
|
|
|
|
|
;; Don't know how to get footnotes and scripture cross references yet.
|
|
|
;;(defconst bible-diatheke-filter-options " afilmnsvw")
|
|
|
@@ -1195,15 +1187,15 @@ both tags, otherwise just get lex definition."
|
|
|
|
|
|
(defun bible-handle-divine-name (item)
|
|
|
"When ITEM is divine name, display it as such."
|
|
|
- (insert "LORD")
|
|
|
- (let* ((refstart (- (point) (length "LORD")))
|
|
|
- (refend (point))
|
|
|
- (strongs (dom-attr item 'savlm)))
|
|
|
- (add-face-text-property refstart refend 'bold)
|
|
|
- (put-text-property refstart refend 'keymap bible-hebrew-keymap)
|
|
|
- (when (and strongs (string-match "strong:H" strongs))
|
|
|
- (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
|
|
|
- (put-text-property refstart refend 'strong (match-string 0 strongs)))))
|
|
|
+ (let ((start (point))
|
|
|
+ (strongs (dom-attr item 'savlm)))
|
|
|
+ (insert "LORD")
|
|
|
+ (let ((end (point)))
|
|
|
+ (add-face-text-property start end 'bold)
|
|
|
+ (put-text-property start end 'keymap bible-hebrew-keymap)
|
|
|
+ (when (and strongs (string-match "strong:H" strongs))
|
|
|
+ (put-text-property start end 'help-echo 'bible--show-lex-morph)
|
|
|
+ (put-text-property start end 'strong (match-string 0 strongs))))))
|
|
|
|
|
|
|
|
|
(defun bible--process-word (item iproperties)
|
|
|
@@ -1216,8 +1208,8 @@ in buffer)."
|
|
|
(savlm (dom-attr item 'savlm))
|
|
|
(lemma (dom-attr item 'lemma))
|
|
|
(divinename (dom-by-tag item 'divinename)))
|
|
|
- (let ((refstart (point))
|
|
|
- (refend (+ (point) (length word))))
|
|
|
+ (let ((start (point))
|
|
|
+ (end (+ (point) (length word))))
|
|
|
(insert word)
|
|
|
;; REVIEW: Special case this. Some modules do this differently.
|
|
|
;; (FMG 5-Mar-2026)
|
|
|
@@ -1227,7 +1219,7 @@ in buffer)."
|
|
|
(just-one-space))
|
|
|
;; Red letter.
|
|
|
(when (plist-get iproperties 'jesus)
|
|
|
- (add-face-text-property refstart refend '(:foreground "red")))
|
|
|
+ (add-face-text-property start end '(:foreground "red")))
|
|
|
;; lexical definitions
|
|
|
;; N.B. There are some severe issues with Strongs numbers in some modules.
|
|
|
(when (or savlm lemma)
|
|
|
@@ -1248,15 +1240,15 @@ in buffer)."
|
|
|
(when lexeme
|
|
|
(cond ((string-match "strong:G.*" lexeme) ; Greek
|
|
|
(setq matched (match-string 0 lexeme))
|
|
|
- (put-text-property refstart refend 'keymap bible-greek-keymap))
|
|
|
+ (put-text-property start end 'keymap bible-greek-keymap))
|
|
|
((string-match "strong:H.*" lexeme) ; Hebrew
|
|
|
(setq matched (match-string 0 lexeme))
|
|
|
- (put-text-property refstart refend 'keymap bible-hebrew-keymap)))
|
|
|
+ (put-text-property start end 'keymap bible-hebrew-keymap)))
|
|
|
;; Add help-echo, strongs reference for tooltips if match.
|
|
|
(when matched
|
|
|
(setq bible-has-lexemes " Lex")
|
|
|
- (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
|
|
|
- (put-text-property refstart refend 'strong matched))))
|
|
|
+ (put-text-property start end 'help-echo 'bible--show-lex-morph)
|
|
|
+ (put-text-property start end 'strong matched))))
|
|
|
;; morphology
|
|
|
(when morph
|
|
|
(let* ((matched nil)
|
|
|
@@ -1269,23 +1261,24 @@ in buffer)."
|
|
|
(setq matched (match-string 0 morpheme)))
|
|
|
(when matched
|
|
|
(setq bible-has-morphemes " Morph")
|
|
|
- (put-text-property refstart refend 'morph matched)
|
|
|
- (put-text-property refstart refend 'help-echo 'bible--show-lex-morph))))
|
|
|
+ (put-text-property start end 'morph matched)
|
|
|
+ (put-text-property start end 'help-echo 'bible--show-lex-morph))))
|
|
|
;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
|
|
|
;; TODO: Should I enable lexicon lookups on these lemmas? I
|
|
|
;; don't use this anyway.... (FMG 5-Mar-2026)
|
|
|
(when (and bible-word-study-enabled lemma (string-match "lemma.*:.*" lemma))
|
|
|
(dolist (word (split-string (match-string 0 lemma) " "))
|
|
|
(setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
|
|
|
+ (just-one-space)
|
|
|
(let ((refstart (point)))
|
|
|
- (insert " " word)
|
|
|
+ (insert word)
|
|
|
(add-face-text-property refstart (point) '(:foreground "blue"))
|
|
|
(put-text-property refstart (point) 'keymap bible-lemma-keymap))))))))
|
|
|
|
|
|
(defun bible-new-line ()
|
|
|
"Ensure beginning of line. Try to avoid redundant blank lines."
|
|
|
(unless (= (current-column) 0)
|
|
|
- (insert "\n")))
|
|
|
+ (newline)))
|
|
|
|
|
|
(defun bible--insert-title (title-node)
|
|
|
"Insert the text in TITLE-NODE into buffer as a chapter title.
|
|
|
@@ -1294,15 +1287,17 @@ title when the new title in `title-node' is different from the one
|
|
|
stored in `bible-chapter-title'."
|
|
|
(unless (equal bible-chapter-title title-node)
|
|
|
(setq-local bible-chapter-title title-node)
|
|
|
- (let ((title-text (bible-dom-texts bible-chapter-title)))
|
|
|
- (let ((refstart (point))
|
|
|
- refend)
|
|
|
- (setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
|
|
|
- (bible-new-line)
|
|
|
- (insert (bidi-string-mark-left-to-right title-text))
|
|
|
- (bible-new-line)
|
|
|
- (setq refend (point))
|
|
|
- (put-text-property refstart refend 'face 'bold)))))
|
|
|
+ (let ((title-text
|
|
|
+ (replace-regexp-in-string ; Clear out XML.
|
|
|
+ "<.*?>" ""
|
|
|
+ (bible-dom-texts bible-chapter-title)))
|
|
|
+ (start (point)))
|
|
|
+ (bible-new-line)
|
|
|
+ ;; Insert the LRM character to make the text render left-to-right.
|
|
|
+ ;; This is necessary in the KJV module when displaying psalm 119.
|
|
|
+ (insert (string ?\x200e) title-text)
|
|
|
+ (put-text-property start (point) 'face 'bold)
|
|
|
+ (newline))))
|
|
|
|
|
|
;; These tags appear in ESV modules (and maybe others?)
|
|
|
;; REVIEW: Is this right? (FMG 5-Mar-2026)
|
|
|
@@ -1317,17 +1312,22 @@ stored in `bible-chapter-title'."
|
|
|
;; REVIEW: Some modules use `level' tag but
|
|
|
;; not in a consistent way. (FMG 7-Mar-2026)
|
|
|
((equal level "1")
|
|
|
- (insert " "))
|
|
|
+ (just-one-space))
|
|
|
((equal level "2")
|
|
|
(newline)))))
|
|
|
|
|
|
+
|
|
|
(defun bible--insert-xref (node)
|
|
|
+ "Insert a cross reference specified by NODE."
|
|
|
+;; TODO: Finish handling multiple consecutive cross references. (FMG 25-Mar-2026)
|
|
|
+;; TODO: Fix punctuation. (FMG 25-Mar-2026)
|
|
|
(let* ((word (bible-dom-text node))
|
|
|
(refs (split-string word ";" t)))
|
|
|
(message "refs %s" refs)
|
|
|
(dolist (ref refs)
|
|
|
+ (just-one-space)
|
|
|
(let ((start (point)))
|
|
|
- (insert " " ref ";")
|
|
|
+ (insert ref)
|
|
|
(let ((end (point)))
|
|
|
(put-text-property start end 'xref ref)
|
|
|
(put-text-property start end 'keymap bible-term-mode-map)
|
|
|
@@ -1371,14 +1371,18 @@ In processing subnodes, each case will prepend a space if it needs it."
|
|
|
;; Font tag should be ignored, treat as if 'w
|
|
|
('font (insert " ") (bible--process-word subnode iproperties))
|
|
|
('hi (when (equal (dom-attr subnode 'type) "bold")
|
|
|
- (let ((word (bible-dom-text subnode)))
|
|
|
- (insert " " word)
|
|
|
- (put-text-property (- (point) (length word)) (point) 'face 'bold))))
|
|
|
+ (just-one-space)
|
|
|
+ (let ((word (bible-dom-text subnode))
|
|
|
+ (start (point)))
|
|
|
+ (insert word)
|
|
|
+ (put-text-property start (point) 'face 'bold))))
|
|
|
('i ; Italic face (special case for certain module)
|
|
|
- (let ((word (bible-dom-text subnode)))
|
|
|
- (insert " " word)
|
|
|
- (put-text-property (- (point) (length word)) (point) 'face 'bold)
|
|
|
- (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
|
|
|
+ (just-one-space)
|
|
|
+ (let ((word (bible-dom-text subnode))
|
|
|
+ (start (point)))
|
|
|
+ (insert word)
|
|
|
+ (put-text-property start (point) 'face 'bold)
|
|
|
+ (add-face-text-property start (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))
|
|
|
@@ -1404,11 +1408,12 @@ In processing subnodes, each case will prepend a space if it needs it."
|
|
|
((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)))
|
|
|
- (insert " " word)
|
|
|
- (if (plist-get iproperties 'jesus)
|
|
|
- (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
|
|
|
- (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
|
|
|
+ (insert " ")
|
|
|
+ (let ((word (bible-dom-text subnode))
|
|
|
+ (start (point))
|
|
|
+ (face (if (plist-get iproperties 'jesus) '(:foreground "salmon") '(:foreground "gray50"))))
|
|
|
+ (insert word)
|
|
|
+ (add-face-text-property start (point) face)))))))))
|
|
|
|
|
|
(defun bible--display (&optional _module verse)
|
|
|
"Render a page (chapter) of a Bible module.
|
|
|
@@ -1521,8 +1526,6 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
(setq bible--commentaries (cl-sort commentaries #'compare-module-names :key #'car)))
|
|
|
nil)
|
|
|
|
|
|
-
|
|
|
-
|
|
|
(defun bible--list-biblical-texts ()
|
|
|
"Return a list of accessible Biblical Text modules."
|
|
|
(bible--get-biblical-modules) ; Make sure the lists are fresh.
|
|
|
@@ -1674,6 +1677,7 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
;;; (put-text-property start end 'keymap bible-greek-keymap)
|
|
|
;;; (add-face-text-property start end `(:foreground "blue")))))))
|
|
|
;; This enables clicking on verse references.
|
|
|
+ ;; REVIEW: this should be conflated with bible--insert-xref above. (FMG 25-Mar-2026)
|
|
|
(save-excursion
|
|
|
(while (search-forward-regexp bible--verse-regexp nil t)
|
|
|
(let ((match (match-string 0))
|