|
|
@@ -1,4 +1,4 @@
|
|
|
-;;; bible.el --- A Bible browsing application -*- lexical-binding: t; mode: EMACS-LISP; -*-
|
|
|
+;;; bible.el --- A Bible browsing application -*- lexical-binding: t; mode: EMACS-LISP; indent-tabs-mode: nil -*-
|
|
|
|
|
|
;; Copyright (c) 2025-2026 Fred Gilham
|
|
|
|
|
|
@@ -23,6 +23,7 @@
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
|
;; along with this file; see the file LICENSE. If not, see
|
|
|
;; <https://www.gnu.org/licenses/>.
|
|
|
+
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
|
@@ -40,9 +41,11 @@
|
|
|
;; The program also installs a Bible menu with keybindings and other
|
|
|
;; commands.
|
|
|
|
|
|
-;; You may customize `bible-text' to set a default browsing
|
|
|
-;; module, as well as `bible-word-study-enabled' to enable word
|
|
|
-;; study by default.
|
|
|
+;; You may customize `bible-text' to set a default browsing module, as
|
|
|
+;; well as `bible-word-study-enabled' to enable word study by default.
|
|
|
+;; NB: Currently this just shows the lemmas in the original language
|
|
|
+;; if present. Tooltips will display whenever there are strongs
|
|
|
+;; numbers in the module.
|
|
|
|
|
|
;;;; Design
|
|
|
|
|
|
@@ -64,6 +67,7 @@
|
|
|
;; up a tooltip with information about the word. Clicking on a word
|
|
|
;; with lexical information will display that information in a "term"
|
|
|
;; buffer.
|
|
|
+
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
@@ -78,17 +82,20 @@
|
|
|
(global-eldoc-mode -1)
|
|
|
|
|
|
;;;; Requirements
|
|
|
-
|
|
|
(require 'cl-lib)
|
|
|
(require 'dom)
|
|
|
(require 'shr)
|
|
|
+(require 'menu+ nil t) ; If you have it, it looks nice.
|
|
|
+
|
|
|
|
|
|
;;;; Aliases for obsolete functions
|
|
|
|
|
|
;; dom-text and dom-texts declared obsolescent in Emacs 31. Check for
|
|
|
;; new function, retain backward compatibility.
|
|
|
+;; Note that the following is the simplest way I found to avoid compile warnings.
|
|
|
(defalias 'bible-dom-text (if (fboundp 'dom-inner-text) 'dom-inner-text 'dom-text))
|
|
|
-(defalias 'bible-dom-texts (if (fboundp 'dom-inner-text) 'dom-inner-text 'dom-texts))
|
|
|
+(defalias 'bible-dom-texts (if (fboundp 'dom-inner-texts) 'dom-inner-text 'dom-texts))
|
|
|
+
|
|
|
|
|
|
;;;; Customization Variables
|
|
|
|
|
|
@@ -207,6 +214,7 @@ See `bible--display-lemma-hebrew'."
|
|
|
:type 'boolean
|
|
|
:local nil
|
|
|
:group 'bible)
|
|
|
+
|
|
|
|
|
|
;;;; Mode line formats for different kinds of buffers.
|
|
|
|
|
|
@@ -241,6 +249,7 @@ See `bible--display-lemma-hebrew'."
|
|
|
" " mode-line-modes mode-line-misc-info
|
|
|
mode-line-end-spaces)
|
|
|
"Mode line format for bible search buffers.")
|
|
|
+
|
|
|
|
|
|
;;;; Modes
|
|
|
|
|
|
@@ -264,7 +273,6 @@ See `bible--display-lemma-hebrew'."
|
|
|
(setq buffer-read-only t)
|
|
|
(visual-line-mode t))
|
|
|
|
|
|
-
|
|
|
(define-derived-mode bible-term-mode special-mode "Bible Term"
|
|
|
"Mode for researching terms in the Bible.
|
|
|
\\{bible-term-mode-map}"
|
|
|
@@ -289,8 +297,8 @@ See `bible--display-lemma-hebrew'."
|
|
|
(buffer-disable-undo)
|
|
|
(font-lock-mode t)
|
|
|
(setq buffer-read-only t))
|
|
|
-
|
|
|
|
|
|
+
|
|
|
;;;; Keymaps
|
|
|
|
|
|
;; N.B. Bible Menu items appear in reverse order of their definition
|
|
|
@@ -345,7 +353,7 @@ See `bible--display-lemma-hebrew'."
|
|
|
|
|
|
(define-key bible-map "S" 'bible-toggle-buffer-sync)
|
|
|
(define-key bible-map [menu-bar bible sync]
|
|
|
- '("Toggle Synchronize Buffer" . bible-toggle-buffer-sync))
|
|
|
+ '("Toggle Synchronize Buffer" . bible-toggle-buffer-sync))
|
|
|
|
|
|
;;;;; Navigation
|
|
|
|
|
|
@@ -453,8 +461,8 @@ See `bible--display-lemma-hebrew'."
|
|
|
(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)
|
|
|
-
|
|
|
|
|
|
+
|
|
|
;;;; Variable definitions
|
|
|
|
|
|
(defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
|
|
|
@@ -689,6 +697,7 @@ Mostly in Psalms, like `Of David' or the like.")
|
|
|
(defvar-local bible-search-text-this-query "")
|
|
|
(defvar-local bible-search-range-this-query nil)
|
|
|
(defvar-local bible-search-matches 0)
|
|
|
+
|
|
|
|
|
|
;;;; Functions
|
|
|
|
|
|
@@ -732,8 +741,8 @@ Mostly in Psalms, like `Of David' or the like.")
|
|
|
(setq tooltip-resize-echo-area (not bible-use-tooltips))
|
|
|
(setq bible-show-diatheke-exec (and bible-show-diatheke-exec bible-use-tooltips)) ; Don't conflict with echo area
|
|
|
(message ""))
|
|
|
-
|
|
|
|
|
|
+
|
|
|
;;;;; Commands (interactive)
|
|
|
|
|
|
(defun bible-open (&optional book-name chapter verse module)
|
|
|
@@ -768,10 +777,10 @@ specifies the module to use."
|
|
|
(bible--do-set-location book chapter verse)
|
|
|
(when (cl-find buffer bible--synced-buffers)
|
|
|
(save-excursion
|
|
|
- (dolist (buf bible--synced-buffers)
|
|
|
- (unless (eq buf buffer)
|
|
|
- (with-current-buffer buf
|
|
|
- (bible--do-set-location book chapter verse))))))))
|
|
|
+ (dolist (buf bible--synced-buffers)
|
|
|
+ (unless (eq buf buffer)
|
|
|
+ (with-current-buffer buf
|
|
|
+ (bible--do-set-location book chapter verse))))))))
|
|
|
|
|
|
(defun bible-next-chapter ()
|
|
|
"Page to the next chapter for the active `bible' buffer and
|
|
|
@@ -812,9 +821,9 @@ for any synchronized buffers."
|
|
|
(book-data (assoc (completing-read "Book: " bible--books nil t) bible--books))
|
|
|
(book-data-string (car book-data))
|
|
|
(chapter (string-to-number
|
|
|
- (completing-read
|
|
|
- "Chapter [1]: "
|
|
|
- (bible--list-number-range 1 (cdr book-data)) nil t nil nil "1"))))
|
|
|
+ (completing-read
|
|
|
+ "Chapter [1]: "
|
|
|
+ (bible--list-number-range 1 (cdr book-data)) nil t nil nil "1"))))
|
|
|
(pcase (aref book-data-string 0)
|
|
|
(?1 (setq book-data (cons (concat "I" (substring book-data-string 1)) (cdr book-data))))
|
|
|
(?2 (setq book-data (cons (concat "II" (substring book-data-string 1)) (cdr book-data))))
|
|
|
@@ -826,9 +835,9 @@ for any synchronized buffers."
|
|
|
(interactive)
|
|
|
(let* ((book-chapters (cdr bible--current-book))
|
|
|
(chapter (string-to-number
|
|
|
- (completing-read
|
|
|
- "Chapter [1]: "
|
|
|
- (bible--list-number-range 1 book-chapters) nil t nil nil "1"))))
|
|
|
+ (completing-read
|
|
|
+ "Chapter [1]: "
|
|
|
+ (bible--list-number-range 1 book-chapters) nil t nil nil "1"))))
|
|
|
(when chapter
|
|
|
(bible--set-location bible--current-book chapter))))
|
|
|
|
|
|
@@ -878,9 +887,9 @@ for any synchronized buffers."
|
|
|
(interactive)
|
|
|
(let ((buffer (current-buffer)))
|
|
|
(if bible--synced-p
|
|
|
- (progn
|
|
|
- (setq bible--synced-buffers (cl-delete buffer bible--synced-buffers))
|
|
|
- (setq-local bible--synced-p nil))
|
|
|
+ (progn
|
|
|
+ (setq bible--synced-buffers (cl-delete buffer bible--synced-buffers))
|
|
|
+ (setq-local bible--synced-p nil))
|
|
|
(cl-pushnew buffer bible--synced-buffers)
|
|
|
(setq-local bible--synced-p t))
|
|
|
(force-mode-line-update)))
|
|
|
@@ -941,21 +950,21 @@ Handle abbreviations."
|
|
|
(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
|
|
|
+ (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) ":")))
|
|
|
((= (length verse-ref) 3) ; II Cor 3:17 or the like
|
|
|
(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)))
|
|
|
- (chapter (car chapter-verse))
|
|
|
+ ;; 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)))
|
|
|
+ (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 (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
|
|
|
@@ -982,6 +991,7 @@ Handle abbreviations."
|
|
|
(query (concat (car book-data) " " chapter ":" verse))
|
|
|
(args (list bible-sword-query nil (current-buffer) t "-b" bible-text "-f" "plain" "-k" query)))
|
|
|
(apply #'call-process args)))
|
|
|
+
|
|
|
|
|
|
;;;;;; Support (internal)
|
|
|
|
|
|
@@ -995,14 +1005,14 @@ string containing query result."
|
|
|
(let ((module (or module bible-text)))
|
|
|
(with-temp-buffer
|
|
|
(let ((args (list bible-sword-query nil (current-buffer) t "-b" module)))
|
|
|
- (if filter
|
|
|
+ (if filter
|
|
|
(setq filter (concat filter bible-diatheke-filter-options))
|
|
|
(setq filter bible-diatheke-filter-options))
|
|
|
- (setq args (append args (list "-o" filter)))
|
|
|
- (setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
|
|
|
- (when bible-show-diatheke-exec
|
|
|
+ (setq args (append args (list "-o" filter)))
|
|
|
+ (setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
|
|
|
+ (when bible-show-diatheke-exec
|
|
|
(message "%s" args))
|
|
|
- (apply #'call-process args))
|
|
|
+ (apply #'call-process args))
|
|
|
(buffer-string))))
|
|
|
|
|
|
(defun bible--diatheke-search (query searchtype &optional format module)
|
|
|
@@ -1045,6 +1055,7 @@ Render HTML, return string. Do some tweaking specific to morphology."
|
|
|
"Execute `diatheke' for QUERY, using MODULE.
|
|
|
Plain format, returns string."
|
|
|
(bible--exec-diatheke query nil "plain" module))
|
|
|
+
|
|
|
|
|
|
;;;;;; Lexicon processing
|
|
|
|
|
|
@@ -1090,14 +1101,13 @@ them to the <bookname> <chapter>:<verse> format."
|
|
|
(set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
|
|
|
(insert verse-ref-string))))))
|
|
|
|
|
|
-
|
|
|
+
|
|
|
(defun bible--cleanup-lex-text (lex-text)
|
|
|
"Reformat tooltip text LEX-TEXT so tooltips look nice."
|
|
|
(dolist (outline-string bible-outline-strings)
|
|
|
(setq lex-text (string-replace (car outline-string) (cdr outline-string) lex-text)))
|
|
|
lex-text)
|
|
|
|
|
|
-
|
|
|
(defun bible--lookup-def-greek (key)
|
|
|
"Execute `diatheke' to do query on KEY.
|
|
|
Massage output so verse cross references are usable. Returns string."
|
|
|
@@ -1122,7 +1132,6 @@ lexical definition is set for a particular lexicon."
|
|
|
(let ((lemma (caddr (split-string lemma-entry " "))))
|
|
|
(bible--lookup-def-greek lemma)))))
|
|
|
|
|
|
-
|
|
|
(defun bible--lookup-lemma-greek (key)
|
|
|
"Lookup lexical definition using Strong's number KEY.
|
|
|
1. Check hash table first. If entry found, return.
|
|
|
@@ -1135,7 +1144,6 @@ lexical definition is set for a particular lexicon."
|
|
|
(bible--lookup-def-greek key))
|
|
|
bible-hash-greek)))
|
|
|
|
|
|
-
|
|
|
(defun bible--lookup-def-hebrew (key)
|
|
|
"Execute `diatheke' to do query on KEY.
|
|
|
Massage output so various cross references are usable. Returns string."
|
|
|
@@ -1146,7 +1154,7 @@ Massage output so various cross references are usable. Returns string."
|
|
|
(apply #'call-process args)
|
|
|
(bible--process-href)
|
|
|
(concat (string ?\x200e)
|
|
|
- (bible--remove-module-name bible-hebrew-lexicon (substring (buffer-string) 7))))))
|
|
|
+ (bible--remove-module-name bible-hebrew-lexicon (substring (buffer-string) 7))))))
|
|
|
|
|
|
(defun bible--lookup-lemma-hebrew (key)
|
|
|
"Lookup lexical definition using Strong's number KEY.
|
|
|
@@ -1158,7 +1166,6 @@ Massage output so various cross references are usable. Returns string."
|
|
|
(bible--lookup-def-hebrew key)
|
|
|
bible-hash-hebrew)))
|
|
|
|
|
|
-
|
|
|
;; We use the shorter lexicons for text in tooltips. We also cache the
|
|
|
;; lex and morph strings, hoping to speed up tooltip rendering.
|
|
|
|
|
|
@@ -1186,9 +1193,9 @@ database and stash in cache."
|
|
|
(setq lex-text
|
|
|
(cond ((string-prefix-p "G" key)
|
|
|
(bible--lookup-lemma-short key bible-greek-lexicon-short))
|
|
|
- ((string-prefix-p "H" key)
|
|
|
+ ((string-prefix-p "H" key)
|
|
|
(concat (string ?\x200e)
|
|
|
- (bible--lookup-lemma-short key bible-hebrew-lexicon-short)))))
|
|
|
+ (bible--lookup-lemma-short key bible-hebrew-lexicon-short)))))
|
|
|
(puthash key (string-fill (bible--cleanup-lex-text lex-text) 75) lex-hash)))))
|
|
|
|
|
|
(defun bible--lookup-morph-entry (morph)
|
|
|
@@ -1199,7 +1206,7 @@ database and stash in cache."
|
|
|
(or (gethash morph morph-hash)
|
|
|
(puthash morph
|
|
|
(let (morph-module morph-key)
|
|
|
- ;; We know about these modules. (Assume they're installed.)
|
|
|
+ ;; We know about these modules. (Assume they're installed.)
|
|
|
(cond ((string-prefix-p "robinson:" morph)
|
|
|
(setq morph-module "Robinson")
|
|
|
(setq morph-key (substring morph (length "robinson:"))))
|
|
|
@@ -1209,8 +1216,8 @@ database and stash in cache."
|
|
|
((string-prefix-p "oshm:" morph)
|
|
|
(setq morph-module "OSHM")
|
|
|
(setq morph-key (substring morph (length "oshm:")))))
|
|
|
- (bible--remove-module-name morph-module (bible--morph-query morph-key morph-module)))
|
|
|
- morph-hash))))
|
|
|
+ (bible--remove-module-name morph-module (bible--morph-query morph-key morph-module)))
|
|
|
+ morph-hash))))
|
|
|
|
|
|
;; Get string for tooltip display
|
|
|
(defun bible--show-lex-morph (_window object pos)
|
|
|
@@ -1234,20 +1241,21 @@ both tags, otherwise just get lex definition."
|
|
|
(if morph-text
|
|
|
(concat (string-trim lex-text) "\n" (string-trim morph-text))
|
|
|
(string-trim lex-text))))))
|
|
|
+
|
|
|
|
|
|
;;;; Display module text
|
|
|
|
|
|
(defun bible-handle-divine-name (item)
|
|
|
"When ITEM is divine name, display it as such."
|
|
|
(let ((start (point))
|
|
|
- (strongs (dom-attr item 'savlm)))
|
|
|
+ (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))))))
|
|
|
+ (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)
|
|
|
@@ -1266,9 +1274,9 @@ in buffer)."
|
|
|
;; REVIEW: Special case this. Some modules do this differently.
|
|
|
;; (FMG 5-Mar-2026)
|
|
|
(when divinename
|
|
|
- (just-one-space)
|
|
|
+ (just-one-space)
|
|
|
(bible-handle-divine-name item)
|
|
|
- (just-one-space))
|
|
|
+ (just-one-space))
|
|
|
;; Red letter.
|
|
|
(when (plist-get iproperties 'jesus)
|
|
|
(add-face-text-property start end '(:foreground "red")))
|
|
|
@@ -1284,8 +1292,8 @@ in buffer)."
|
|
|
(let ((lexeme-list
|
|
|
(if (string= bible-text "KJV")
|
|
|
(reverse lexemes) ; Use the last `strong:' entry.
|
|
|
- lexemes)))
|
|
|
- (catch 'loop
|
|
|
+ lexemes)))
|
|
|
+ (catch 'loop
|
|
|
(dolist (item lexeme-list)
|
|
|
(when (string-prefix-p "strong:" item)
|
|
|
(throw 'loop item)))))))
|
|
|
@@ -1321,12 +1329,13 @@ in buffer)."
|
|
|
(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)
|
|
|
+ (just-one-space)
|
|
|
(let ((refstart (point)))
|
|
|
(insert word)
|
|
|
(add-face-text-property refstart (point) '(:foreground "blue"))
|
|
|
(put-text-property refstart (point) 'keymap bible-lemma-keymap))))))))
|
|
|
|
|
|
+
|
|
|
(defun bible--insert-title (title-node)
|
|
|
"Insert the text in TITLE-NODE into buffer as a chapter title.
|
|
|
Since each verse will have a `title' tag, keep track and only emit a
|
|
|
@@ -1335,10 +1344,10 @@ stored in `bible-chapter-title'."
|
|
|
(unless (equal bible-chapter-title title-node)
|
|
|
(setq-local bible-chapter-title title-node)
|
|
|
(let ((title-text
|
|
|
- (replace-regexp-in-string ; Clear out XML.
|
|
|
- "<.*?>" ""
|
|
|
- (bible-dom-texts bible-chapter-title)))
|
|
|
- (start (point)))
|
|
|
+ (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.
|
|
|
@@ -1352,39 +1361,64 @@ stored in `bible-chapter-title'."
|
|
|
(defun bible--level-tag (node)
|
|
|
"Indent or break line as dictated by NODE."
|
|
|
(let ((type (dom-attr node 'type))
|
|
|
- (level (dom-attr node 'level)))
|
|
|
+ (level (dom-attr node 'level)))
|
|
|
(cond ((and type (string-equal-ignore-case type "x-br"))
|
|
|
- (newline))
|
|
|
+ (newline))
|
|
|
((and type (string-equal-ignore-case type "x-indent"))
|
|
|
(insert "\t"))
|
|
|
- ;; REVIEW: Some modules use `level' tag but
|
|
|
- ;; not in a consistent way. (FMG 7-Mar-2026)
|
|
|
- ((equal level "1")
|
|
|
- (just-one-space))
|
|
|
+ ;; REVIEW: Some modules use `level' tag but
|
|
|
+ ;; not in a consistent way. (FMG 7-Mar-2026)
|
|
|
+ ((equal level "1")
|
|
|
+ (just-one-space))
|
|
|
((equal level "2")
|
|
|
- (newline)
|
|
|
- (delete-blank-lines)))))
|
|
|
-
|
|
|
+ (newline)
|
|
|
+ (delete-blank-lines)))))
|
|
|
|
|
|
+(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."
|
|
|
-;; 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 "ref-word: %s" word)
|
|
|
+ ;; 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 "ref %s" ref)
|
|
|
- (just-one-space)
|
|
|
- (let ((start (point)))
|
|
|
- (insert ref)
|
|
|
- (let ((end (point)))
|
|
|
- (put-text-property start end 'xref ref)
|
|
|
- (put-text-property start end 'keymap bible-term-mode-map)
|
|
|
- (put-text-property start end 'help-echo (concat "Go to " ref))
|
|
|
- (add-face-text-property start end '(:foreground "blue")))))))
|
|
|
-
|
|
|
+;; (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>)
|
|
|
+ ;; <chapter>:verse
|
|
|
+ ;; <verse> (or maybe <verse>-<verse>)
|
|
|
+ ;; Books may look like this: <1 Cor> or <Gal> so we have to deal with the possible space.
|
|
|
+ ;; We ignore verse ranges and hope for the best (it seems to do the right thing).
|
|
|
+ (let ((_set-book-p nil)
|
|
|
+ (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 set-book-p t))
|
|
|
+ (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)))
|
|
|
+ (when verse (setq the-ref (concat the-ref ":" verse)))
|
|
|
+ (insert b-ref)
|
|
|
+ (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'.
|
|
|
Inserts resulting text into active buffer with properties specified in
|
|
|
@@ -1404,66 +1438,67 @@ In processing subnodes, each case will prepend a space if it needs it."
|
|
|
(let ((tag (dom-tag subnode)))
|
|
|
(pcase tag
|
|
|
;; TODO: There are lots of tags we don't handle, especially in commentaries.
|
|
|
- ;; Maybe process these at some point? Include footnotes etc.
|
|
|
+ ;; Maybe process these at some point? Include footnotes etc.
|
|
|
;; (FMG 5-Mar-2026)
|
|
|
;; 'w is usual case.
|
|
|
('w (insert " ") (bible--process-word subnode iproperties))
|
|
|
- ('title
|
|
|
- ;; 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.
|
|
|
- (if bible-chapter-title
|
|
|
- (bible--insert-title subnode) ; Middle of chapter.
|
|
|
- (save-excursion ; Beginning of chapter.
|
|
|
- (goto-char (point-min))
|
|
|
- (bible--insert-title subnode))))
|
|
|
- ;; Font tag ignored for now, treat as if 'w.
|
|
|
+ ('title
|
|
|
+ ;; 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.
|
|
|
+ (if bible-chapter-title
|
|
|
+ (bible--insert-title subnode) ; Middle of chapter.
|
|
|
+ (save-excursion ; Beginning of chapter.
|
|
|
+ (goto-char (point-min))
|
|
|
+ (bible--insert-title subnode))))
|
|
|
+ ;; Font tag ignored for now, treat as if 'w.
|
|
|
('font (insert " ") (bible--process-word subnode iproperties))
|
|
|
('hi (when (equal (dom-attr subnode 'type) "bold")
|
|
|
- (just-one-space)
|
|
|
+ (just-one-space)
|
|
|
(let ((word (bible-dom-text subnode))
|
|
|
- (start (point)))
|
|
|
+ (start (point)))
|
|
|
(insert word)
|
|
|
(put-text-property start (point) 'face 'bold))))
|
|
|
- ;; Italic face (special case for certain module)
|
|
|
+ ;; Italic face (special case for certain module)
|
|
|
('i
|
|
|
- (just-one-space)
|
|
|
+ (just-one-space)
|
|
|
(let ((word (bible-dom-text subnode))
|
|
|
- (start (point)))
|
|
|
+ (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))
|
|
|
+ ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties))
|
|
|
('l (bible--level-tag subnode))
|
|
|
- ;; REVIEW: divine name handling doesn't seem to work the same
|
|
|
- ;; with all modules. (FMG 26-Mar-2026)
|
|
|
- ('divinename (bible-handle-divine-name subnode))
|
|
|
+ ;; REVIEW: divine name handling doesn't seem to work the same
|
|
|
+ ;; with all modules. (FMG 26-Mar-2026)
|
|
|
+ ('divinename (bible-handle-divine-name subnode))
|
|
|
;; Some modules use this for line breaks and such.
|
|
|
('milestone
|
|
|
- (pcase (dom-attr subnode 'type)
|
|
|
- ("line" (bible-new-line))
|
|
|
-;; ("x-PN" (bible-new-line)) ; REVIEW: Don't yet understand this one. (FMG 26-Mar-2026)
|
|
|
- ("x-p" (insert (dom-attr subnode 'marker) " "))))
|
|
|
+ (pcase (dom-attr subnode 'type)
|
|
|
+ ("line" (bible-new-line))
|
|
|
+;; ("x-PN" (bible-new-line)) ; REVIEW: Don't yet understand this one. (FMG 26-Mar-2026)
|
|
|
+ ("x-p" (insert (dom-attr subnode 'marker) " "))))
|
|
|
('br (bible-new-line))
|
|
|
('lb (when (equal (dom-attr subnode 'type) "x-begin-paragraph") (bible-new-line)))
|
|
|
('div (when (or (equal (dom-attr subnode 'type) "paragraph")
|
|
|
- (equal (dom-attr subnode 'type) "x-p"))
|
|
|
- (bible-new-line)))
|
|
|
+ (equal (dom-attr subnode 'type) "x-p"))
|
|
|
+ (bible-new-line)))
|
|
|
;; For commentaries and the like.
|
|
|
((or 'scripref 'reference) (bible--insert-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.
|
|
|
('transchange
|
|
|
- (insert " ")
|
|
|
+ (insert " ")
|
|
|
(let ((word (bible-dom-text subnode))
|
|
|
- (start (point))
|
|
|
- (face (if (plist-get iproperties 'jesus) '(:foreground "salmon") '(:foreground "gray50"))))
|
|
|
+ (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 verse)
|
|
|
"Render a page (chapter) of a Bible module.
|
|
|
Defaults to using `bible-text'.
|
|
|
@@ -1478,30 +1513,30 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
;; Render the DOM tree into the buffer.
|
|
|
(unless bible-debugme ; If this is true, display the XML.
|
|
|
(erase-buffer)
|
|
|
- (setq-local bible-chapter-title nil)
|
|
|
+ (setq-local bible-chapter-title nil)
|
|
|
;; Looking for the "body" tag in the DOM node.
|
|
|
- (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body))
|
|
|
+ (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body))
|
|
|
(goto-char (point-min))))
|
|
|
(save-excursion
|
|
|
(let ((search-string (concat " *" (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
|
|
|
;; Delete <Book Ch:> at beginning of verse, just leave verse number.
|
|
|
(while (re-search-forward search-string nil t)
|
|
|
(replace-match "")
|
|
|
- (bible-new-line)
|
|
|
+ (bible-new-line)
|
|
|
;; Highlight verse number
|
|
|
- (when (re-search-forward " *[0-9]+:" nil t 1)
|
|
|
- (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
|
|
|
+ (when (re-search-forward " *[0-9]+:" nil t 1)
|
|
|
+ (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
|
|
|
(save-excursion
|
|
|
;; Fix divine name lossage.
|
|
|
(while (re-search-forward "Lord LORD" nil t)
|
|
|
- (replace-match "LORD")
|
|
|
- (add-face-text-property (point) (- (point) 4) 'bold))
|
|
|
+ (replace-match "LORD")
|
|
|
+ (add-face-text-property (point) (- (point) 4) 'bold))
|
|
|
(while (re-search-forward "Lord.+s LORD" nil t -1)
|
|
|
- (replace-match "LORD's")
|
|
|
- (add-face-text-property (1- (point)) (- (point) 5) 'bold))
|
|
|
+ (replace-match "LORD's")
|
|
|
+ (add-face-text-property (1- (point)) (- (point) 5) 'bold))
|
|
|
;; Remove the module name from the buffer.
|
|
|
(while (re-search-forward (concat "^.*" bible-text ".*$") nil t)
|
|
|
- (replace-match ""))
|
|
|
+ (replace-match ""))
|
|
|
(delete-blank-lines))
|
|
|
(save-excursion
|
|
|
(format-replace-strings '(("." . ". ")
|
|
|
@@ -1528,16 +1563,17 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
(just-one-space)))
|
|
|
;; Set the mode line of the biffer.
|
|
|
(if bible-has-lexemes
|
|
|
- (unless (string-match " Lex" mode-name) (setq mode-name (concat mode-name " Lex")))
|
|
|
+ (unless (string-match " Lex" mode-name) (setq mode-name (concat mode-name " Lex")))
|
|
|
(setq mode-name (replace-regexp-in-string " Lex" "" mode-name)))
|
|
|
(if bible-has-morphemes
|
|
|
- (unless (string-match " Morph" mode-name) (setq mode-name (concat mode-name " Morph")))
|
|
|
+ (unless (string-match " Morph" mode-name) (setq mode-name (concat mode-name " Morph")))
|
|
|
(setq mode-name (replace-regexp-in-string " Morph" "" mode-name)))
|
|
|
(force-mode-line-update))
|
|
|
;; If optional verse specification go to that verse.
|
|
|
(when verse
|
|
|
(re-search-forward (concat " ?" (number-to-string verse)) nil t)))
|
|
|
|
|
|
+
|
|
|
;;;; Modules (Bible texts, commentaries)
|
|
|
|
|
|
(defun compare-module-names (n1 n2)
|
|
|
@@ -1547,35 +1583,36 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
(defun bible--get-biblical-modules ()
|
|
|
"Populate `bible--texts' and `bible--commentaries' lists."
|
|
|
(let ((lines
|
|
|
- (split-string
|
|
|
- (bible--exec-diatheke "modulelist" nil "plain" "system")
|
|
|
- "[\n\r]+"))
|
|
|
- (texts nil)
|
|
|
- (commentaries nil)
|
|
|
- (doing-texts nil)
|
|
|
- (doing-commentaries nil))
|
|
|
+ (split-string
|
|
|
+ (bible--exec-diatheke "modulelist" nil "plain" "system")
|
|
|
+ "[\n\r]+"))
|
|
|
+ (texts nil)
|
|
|
+ (commentaries nil)
|
|
|
+ (doing-texts nil)
|
|
|
+ (doing-commentaries nil))
|
|
|
(setq bible--texts nil)
|
|
|
(setq bible--commentaries nil)
|
|
|
(catch 'done
|
|
|
(dolist (line lines)
|
|
|
- (when doing-texts
|
|
|
- (push (split-string line " : ") texts))
|
|
|
- (when doing-commentaries
|
|
|
- (push (split-string line " : ") commentaries))
|
|
|
- (when (string-equal line "Biblical Texts:")
|
|
|
- (setq doing-texts t))
|
|
|
- (when (string-equal line "Commentaries:")
|
|
|
- (setq doing-texts nil)
|
|
|
- (pop texts) ; Remove `Commentaries:' line from `bible--texts'.
|
|
|
- (setq doing-commentaries t))
|
|
|
- (when (string-equal line "Lexicons / Dictionaries:")
|
|
|
- (pop commentaries) ; Remove `Lexicons / Dictionaries:' line
|
|
|
- ; from bible--commentaries.
|
|
|
- (throw 'done nil))))
|
|
|
+ (when doing-texts
|
|
|
+ (push (split-string line " : ") texts))
|
|
|
+ (when doing-commentaries
|
|
|
+ (push (split-string line " : ") commentaries))
|
|
|
+ (when (string-equal line "Biblical Texts:")
|
|
|
+ (setq doing-texts t))
|
|
|
+ (when (string-equal line "Commentaries:")
|
|
|
+ (setq doing-texts nil)
|
|
|
+ (pop texts) ; Remove `Commentaries:' line from `bible--texts'.
|
|
|
+ (setq doing-commentaries t))
|
|
|
+ (when (string-equal line "Lexicons / Dictionaries:")
|
|
|
+ (pop commentaries) ; Remove `Lexicons / Dictionaries:' line
|
|
|
+ ; from bible--commentaries.
|
|
|
+ (throw 'done nil))))
|
|
|
(setq bible--texts (cl-sort texts #'compare-module-names :key #'car))
|
|
|
(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.
|
|
|
@@ -1633,10 +1670,9 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
(goto-char (point-min))
|
|
|
(pop-to-buffer (current-buffer) nil t)))
|
|
|
|
|
|
-
|
|
|
+
|
|
|
;;;; Bible Searching
|
|
|
|
|
|
-
|
|
|
(defun bible--open-search (query searchmode module)
|
|
|
"Open a search buffer of QUERY using SEARCHMODE in module MODULE."
|
|
|
(let ((results (string-trim (replace-regexp-in-string
|
|
|
@@ -1649,11 +1685,10 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
" Verify index has been build with mkfastmod.")))
|
|
|
(with-current-buffer (get-buffer-create (generate-new-buffer-name (concat "*bible-search*")))
|
|
|
(bible-search-mode)
|
|
|
- (bible--display-search results module)
|
|
|
- (setq-local bible-search-word-this-query query
|
|
|
- bible-search-text-this-query module
|
|
|
- bible-search-range-this-query bible-search-range)
|
|
|
-;; (setq-local mode-line-format bible-search-mode-line-format)
|
|
|
+ (bible--display-search results module)
|
|
|
+ (setq-local bible-search-word-this-query query
|
|
|
+ bible-search-text-this-query module
|
|
|
+ bible-search-range-this-query bible-search-range)
|
|
|
(pop-to-buffer (current-buffer) nil t)))))
|
|
|
|
|
|
(defun bible--display-search (results module)
|
|
|
@@ -1696,32 +1731,31 @@ If optional argument VERSE is supplied, set cursor at verse."
|
|
|
(save-excursion
|
|
|
;; Remove module name from buffer.
|
|
|
(while (re-search-forward (concat "^.*" module ".*$") nil t)
|
|
|
- (replace-match ""))
|
|
|
+ (replace-match ""))
|
|
|
(delete-blank-lines))
|
|
|
(setq mode-name "Bible Search ")
|
|
|
(setq-local bible-search-matches (length verses))))
|
|
|
|
|
|
-
|
|
|
+
|
|
|
;;;; Terms (lemmas, morphemes)
|
|
|
-
|
|
|
(defun bible--get-lemma (language strongs)
|
|
|
"Get the lemma from lexicon for LANGUAGE for strong's term STRONGS.
|
|
|
Used to display lemmas in mode lines. Assumes that StrongsHebrew
|
|
|
and StrongsGreek lexicons have been installed."
|
|
|
(let ((lemma-entry
|
|
|
- (pcase language
|
|
|
- ('hebrew
|
|
|
- ;; Use Strong's Hebrew lexicon to look up Hebrew lemma.
|
|
|
- (bible--lex-query strongs "StrongsHebrew" ))
|
|
|
- ('greek
|
|
|
- ;; Use Strong's Greek lexicon to look up Greek lemma.
|
|
|
- (bible--lex-query strongs "StrongsGreek")))))
|
|
|
+ (pcase language
|
|
|
+ ('hebrew
|
|
|
+ ;; Use Strong's Hebrew lexicon to look up Hebrew lemma.
|
|
|
+ (bible--lex-query strongs "StrongsHebrew" ))
|
|
|
+ ('greek
|
|
|
+ ;; Use Strong's Greek lexicon to look up Greek lemma.
|
|
|
+ (bible--lex-query strongs "StrongsGreek")))))
|
|
|
(unless (equal lemma-entry "")
|
|
|
;; Entry will look like <num>: <num>. <lemma> <definition>. Get
|
|
|
;; rid of everything before and after <lemma>.
|
|
|
(let* ((lemma-line (split-string lemma-entry))
|
|
|
- (lemma (caddr lemma-line)))
|
|
|
- lemma))))
|
|
|
+ (lemma (caddr lemma-line)))
|
|
|
+ lemma))))
|
|
|
|
|
|
(defun bible--display-greek ()
|
|
|
"Display Greek term.
|
|
|
@@ -1796,6 +1830,7 @@ This code is customized for the BDBGlosses_Strongs lexicon."
|
|
|
(erase-buffer)
|
|
|
(insert (bible--lookup-lemma-greek lemma))
|
|
|
(bible--fixup-lexicon-display 'greek)))
|
|
|
+
|
|
|
|
|
|
;;;; Utilities
|
|
|
|
|
|
@@ -1824,4 +1859,6 @@ Used in tandem with `completing-read' for chapter selection."
|
|
|
|
|
|
(provide 'bible)
|
|
|
|
|
|
+
|
|
|
+
|
|
|
;;; bible.el ends here.
|
