Upload files to ''

bible-mode.el

@@ -0,0 +1,1003 @@
+;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
+;;
+;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI
+;; Time-stamp: <2024-05-14 11:32:24 fred>
+
+;; Author: Zacalot
+;; Fixes and modifications by Fred Gilham
+;; Url: https://github.com/fmgilham/bible-mode
+;; Forked from
+;; Url: https://github.com/Zacalot/bible-mode
+;; Version: 1.0.0
+;; Package-Requires: ((emacs "24.1"))
+;; Keywords: diatheke, sword, research, bible
+
+;;; Commentary:
+
+;; This package uses the `diatheke' program to browse and search 
+;; Biblical texts provided by the Sword project. 
+;; Word study is also supported.
+
+;;; Usage:
+
+;; First install `diatheke'.  On Debian/Ubuntu it's in the `diatheke'
+;; package. In other distributions it might be in the sword package.
+
+;; For Windows I found that you can simply install the Xiphos package.
+;; It includes the Sword library and its utilities including diatheke,
+;; installmgr and mkfastmod. Add the "Program Files\Xiphos\bin" path
+;; to your execution path.
+
+;; Use M-x `bible-open' to open a Bible buffer.
+;; Use C-h f `bible-mode' to see available keybindings.
+
+;; You may customize `bible-mode-module' to set a default browsing
+;; module, as well as `bible-mode-word-study-enabled' to enable word
+;; study by default.
+
+;;; Design:
+
+;; The idea here is to use the diatheke program to insert code from
+;; modules into buffers. The main bible display uses an "internal" XML
+;; format. The whole buffer gets parsed by libxml-parse-html-region to
+;; create a dom tree. This gets parsed by
+;; bible-mode--insert-domnode-recursive to render the text into
+;; reading format.
+
+;; The text is then decorated using information from the dom format as
+;; necessary along with regular expressions to identify the verse
+;; references. This is for red letters, purple highlighting of the
+;; verse numbers, bold face of the divine name in the OT and so on.
+
+;; If strongs tags and/or morphological tags are present, they are
+;; looked up in appropriate lexical and morphological modules and used
+;; to add tooltips to the text so that mousing over words will bring
+;; up a tooltip with information about the word. Clicking on a word
+;; with lexical information will display that informatio in a "term"
+;; buffer.
+
+
+;;;
+;;; bm- is used as shorthand (see Local Variables) for bible-mode-
+
+;;; Code:
+
+;;;; Requirements
+(require 'cl-lib) ; XXX FMG there are just a few constructs that use this; use elisp versions instead.
+;; (require 'bidi)
+(require 'dom)
+(require 'shr)
+
+;;;; Variables
+
+(defgroup bible-mode nil
+  "Settings for `bible-mode'."
+  :group 'tools
+  :link '(url-link "https://github.com/fmgilham/bible-mode"))
+
+(defcustom bm-module
+  "KJV"
+  "Book module for Diatheke to query."
+  :type '(choice (const :tag "None" nil)
+                 (string :tag "Module abbreviation (e.g. \"KJV\")"))
+  :local t
+  :group 'bible-mode)
+
+(defcustom bm-font
+  "Ezra SIL"
+  "Default font for bible-mode."
+  :type '(string :tag "Font family name (e.g. \"Ezra SIL\")")
+  :local t
+  :group 'bible-mode)
+
+
+(defcustom bm-greek-lexicon
+  "MLStrong"
+  "Lexicon used for displaying definitions of Greek words using Strong's codes."
+  :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
+  :local nil
+  :group 'bible-mode)
+
+(defcustom bm-short-greek-lexicon
+  "StrongsRealGreek"
+  "Lexicon used for displaying definitions of Greek words in tooltips."
+  :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
+  :local nil
+  :group 'bible-mode)
+
+(defcustom bm-hebrew-lexicon
+  "StrongsRealHebrew"  ; Nice to use BDBGlosses_Strongs but it needs to be special-cased
+  "Lexicon used for displaying definitions of Hebrew words using Strong's codes."
+  :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
+  :local nil
+  :group 'bible-mode)
+
+(defcustom bm-short-hebrew-lexicon
+  "StrongsRealHebrew"
+  "Lexicon used for displaying definitions of Hebrew words in tooltips."
+  :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
+  :local nil
+  :group 'bible-mode)
+
+
+(defcustom bm-word-study-enabled
+  nil
+  "Display Strong's Hebrew, Strong's Greek, and Lemma words for study."
+  :type 'boolean
+  :local t
+  :group 'bible-mode)
+
+(defcustom bm-red-letter-enabled
+  t
+  "Display words of Jesus in red when module has that information."
+  :type 'boolean
+  :local t
+  :group 'bible-mode)
+
+;;; defvars
+
+(defvar bm-modules (lazy-completion-table bm-modules bm-list-biblical-modules))
+
+;; XXX I believe these chapter counts aren't the same for all modules, e.g. JPS.
+(defvar bm-books
+  '(;; Old Testament
+    ("Genesis"		. 50)	("Exodus"		. 40)	("Leviticus"		. 27)	("Numbers"		. 36)
+    ("Deuteronomy"	. 34)	("Joshua"		. 24)	("Judges"		. 21)	("Ruth"			. 4)
+    ("I Samuel"		. 31)	("II Samuel"		. 24)	("I Kings"		. 22)	("II Kings"		. 25)
+    ("I Chronicles"	. 29)	("II Chronicles"	. 36)	("Ezra"			. 10)	("Nehemiah"		. 13)
+    ("Esther" 		. 10)	("Job"			. 42)	("Psalms"		. 150)	("Proverbs"		. 31)
+    ("Ecclesiastes"	. 12)	("Song of Solomon"	. 8)	("Isaiah"		. 66)	("Jeremiah"		. 52)
+    ("Lamentations"	. 5)	("Ezekiel"		. 48)	("Daniel"		. 12)	("Hosea"		. 14)
+    ("Joel"		. 3)	("Amos"			. 9)	("Obadiah"		. 1)	("Jonah"		. 4)
+    ("Micah"		. 7)	("Nahum"		. 3)	("Habakkuk"		. 3)	("Zephaniah"		. 3)
+    ("Haggai"		. 2)	("Zechariah"		. 14)	("Malachi"		. 4)
+    ;; New Testament
+    ("Matthew"		. 28)	("Mark"			. 16)	("Luke"			. 24)	("John"			. 21)
+    ("Acts"		. 28)	("Romans"		. 16)	("I Corinthians"	. 16)	("II Corinthians" 	. 13)
+    ("Galatians"	. 6)	("Ephesians"		. 6)	("Philippians"		. 4)	("Colossians"		. 4)
+    ("I Thessalonians"	. 5)	("II Thessalonians"	. 3)	("I Timothy"		. 6)	("II Timothy"		. 4)
+    ("Titus"		. 3)	("Philemon"		. 1)	("Hebrews"		. 13)	("James"		. 5)
+    ("I Peter"		. 5)	("II Peter"		. 3)	("I John"		. 5)	("II John"		. 1)
+    ("III John"		. 1)    ("Jude"			. 1)	("Revelation of John"	. 22))
+  "A-list of name / chapter count for Bible books.")
+
+;;;; Book / chapter
+
+(defvar-local bm-current-book (assoc "Genesis" bm-books)
+  "Current book data (name . chapter).")
+
+(defvar-local bm-current-book-name "Genesis"
+  "Current book name.")
+
+(defvar-local bm-current-chapter 1
+  "Current book chapter number.")
+
+(defvar-local bm-search-query nil 
+  "Search query associated with the buffer.")
+
+(defvar-local bm-search-mode "phrase"
+  "Search mode: either `lucene' or `phrase'.")
+
+(defvar-local bm-has-strongs nil
+  "Set if the module being displayed has strongs numbers availabile.")
+
+(defvar-local bm-has-morphology nil
+  "Set if the module being displayed has morphology availabile.")
+
+
+;; (defvar bm-current-module nil)
+
+;;;; Keymaps
+
+(defconst bm-map (make-keymap))
+;;;;; Navigation
+(define-key bm-map "n" 'bm-next-chapter)
+(define-key bm-map "p" 'bm-previous-chapter)
+(define-key bm-map (kbd "TAB") 'bm-forward-word) ; TODO: bm-forward-word
+;;;;; Direct jump
+(define-key bm-map "b" 'bm-select-book)
+(define-key bm-map "c" 'bm-select-chapter)
+;;;;; Search
+(define-key bm-map "s" 'bible-search)
+(define-key bm-map "/" 'bible-search)
+;;;; Not yet
+;;(define-key bm-map "" 'bm-set-search-range)
+;;;;; Misc
+(define-key bm-map "m" 'bm-select-module)
+(define-key bm-map "w" 'bm-toggle-word-study)
+(define-key bm-map "x" 'bm-split-display)
+;;;;; Deal with visual-line-mode
+(define-key bm-map "\C-n" 'next-logical-line)
+(define-key bm-map "\C-p" 'previous-logical-line)
+
+(defconst bible-search-mode-map (make-keymap))
+(define-key bible-search-mode-map "s" 'bible-search)
+(define-key bible-search-mode-map "w" 'bm-toggle-word-study)
+(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
+
+(defconst bible-term-hebrew-mode-map (make-keymap))
+(defconst bible-term-greek-mode-map (make-keymap))
+(defconst bible-term-morph-mode-map (make-keymap))
+
+
+;;;
+;;; Menu bar items
+;;;
+;;; Right now just convenience items. More as I think of them.
+;;;
+(define-key global-map [menu-bar bible-mode]
+	    (cons "Bible Mode" (make-sparse-keymap "Bible Mode")))
+
+(defun bm-set-left-to-right ()
+  (interactive)
+  (setq-local bidi-paragraph-direction 'left-to-right))
+
+(defun bm-set-right-to-left ()
+  (interactive)
+  (setq-local bidi-paragraph-direction 'right-to-left))
+
+(define-key global-map
+	    [menu-bar bible-mode left-to-right]
+	    '("Left-to-right" . bm-set-left-to-right))
+
+(define-key global-map 
+	    [menu-bar bible-mode right-to-left]
+	    '("Right-to-left" . bm-set-right-to-left))
+
+(defvar-local bm-debugme nil)
+
+(defun bm-set-display-xml ()
+  (interactive)
+  (setq-local bm-debugme t)
+  (bm-display))
+
+(defun bm-set-display-text ()
+  (interactive)
+  (setq-local bm-debugme nil)
+  (bm-display))
+
+
+(define-key global-map 
+	    [menu-bar bible-mode display-xml]
+	    '("Display XML" . bm-set-display-xml))
+
+(define-key global-map 
+	    [menu-bar bible-mode display-text]
+	    '("Display Text" . bm-set-display-text))
+
+
+(define-key global-map
+	    [menu-bar bible-mode select-biblical-text]
+	    '("Select Text" . bm-display-available-modules))
+
+
+
+(defun bm-display-greek ()
+  (interactive)
+  (let ((item (car (split-string (get-text-property (point) 'strong)))))
+    ;; Remove "strong:G" prefix
+    (bible-term-greek (replace-regexp-in-string "strong:G" "" item))))
+	      
+(defconst bm-greek-keymap (make-sparse-keymap))
+(define-key bm-greek-keymap (kbd "RET") 'bm-display-greek)
+(define-key bm-greek-keymap [mouse-1] 'bm-display-greek)
+
+(defun bm-display-hebrew () 
+  (interactive)
+  (let ((item (car (split-string (get-text-property (point) 'strong)))))
+    ;; Remove "strong:H" prefix and any alphabetic suffixes.
+    (bible-term-hebrew (replace-regexp-in-string "[a-zA-Z]" "" item nil nil nil 8))))
+
+(defconst bm-hebrew-keymap (make-sparse-keymap))
+(define-key bm-hebrew-keymap (kbd "RET") 'bm-display-hebrew)
+(define-key bm-hebrew-keymap [mouse-1] 'bm-display-hebrew)
+
+(defconst bm-lemma-keymap (make-sparse-keymap))
+(define-key bm-lemma-keymap (kbd "RET")
+	    (lambda ()
+	      (interactive)
+	      ))
+
+(defconst bm-morph-keymap (make-sparse-keymap))
+(define-key bm-morph-keymap (kbd "RET")
+	    (lambda ()
+	      (interactive)
+;;;	      (let ((thing (thing-at-point 'word)))
+;;;		(message "thing at point: %s" thing)
+;;;		(message "morph property %s" (get-text-property 0 'field thing))
+		))
+
+;;;; Modes
+
+(define-derived-mode bible-mode special-mode "Bible"
+  "Mode for reading the Bible.
+\\{bm-map}"
+  (buffer-disable-undo)
+  (font-lock-mode t)
+  (use-local-map bm-map)
+  (setq buffer-read-only t)
+  (visual-line-mode t))
+
+
+(define-derived-mode bible-search-mode special-mode "Bible Search"
+  "Mode for performing Bible searches.
+\\{bible-search-mode-map}"
+  (buffer-disable-undo)
+  (font-lock-mode t)
+  (use-local-map bible-search-mode-map)
+  (setq buffer-read-only t)
+  (visual-line-mode t)
+)
+
+(define-derived-mode bible-term-hebrew-mode special-mode "Bible Term (Hebrew)"
+  "Mode for researching Hebrew terms in the Bible.
+\\{bible-term-hebrew-mode-map}"
+  (buffer-disable-undo)
+  (font-lock-mode t)
+  (use-local-map bible-term-hebrew-mode-map)
+  (setq buffer-read-only t)
+  (visual-line-mode t))
+
+(define-derived-mode bible-term-greek-mode special-mode "Bible Term (Greek)"
+  "Mode for researching Greek terms in the Bible.
+\\{bible-term-greek-mode-map}"
+  (buffer-disable-undo)
+  (font-lock-mode t)
+  (use-local-map bible-term-greek-mode-map)
+  (setq buffer-read-only t)
+  (visual-line-mode t))
+
+;;;; Functions
+
+;;;;; Commands
+
+;;;###autoload
+(defun bible-open (&optional book-name chapter verse)
+  "Creates and opens a `bible-mode' buffer"
+  (interactive)
+  (let ((buf (get-buffer-create (generate-new-buffer-name (concat "*bible*")))))
+    (set-buffer buf)
+    (bible-mode)
+    (bm-set-location (assoc (or book-name "Genesis") bm-books) (or chapter 1) verse)
+    (set-window-buffer (get-buffer-window (current-buffer)) buf)))
+
+;;;###autoload
+(defun bm-next-chapter ()
+  "Pages to the next chapter for the active `bible-mode' buffer."
+  (interactive)
+  (let* ((book-chapters (cdr bm-current-book))
+	 (chapter (min book-chapters (+ bm-current-chapter 1))))
+    (bm-set-location bm-current-book chapter)))
+
+;;;###autoload
+(defun bm-previous-chapter ()
+  "Pages to the previous chapter for the active `bible-mode' buffer."
+  (interactive)
+  (bm-set-location bm-current-book (max 1 (- bm-current-chapter 1))))
+
+
+(defun bm-forward-word ()
+  "Moves forward a word, taking into account the relevant text properties.
+XXX Doesn't work yet."
+  (interactive)
+  (field-end))
+
+
+
+;;;###autoload
+(defun bm-select-book ()
+  "Queries user to select a new book and chapter for the current
+`bible-mode' buffer."
+  (interactive)
+  (let* ((completion-ignore-case t)
+	 (book-data (assoc (completing-read "Book: " bm-books nil t) bm-books))
+         (chapter (string-to-number (completing-read "Chapter: " (bm-list-number-range 1 (cdr book-data)) nil t))))
+    (setq-local bm-current-book book-data)
+    (setq-local bm-current-book-name (car book-data))
+    (setq-local bm-current-chapter chapter)
+    (bm-display)))
+
+
+;;;###autoload
+(defun bm-select-chapter ()
+  "Queries user to select a new chapter for the current `bible-mode' buffer."
+  (interactive)
+  (let* ((book-chapters (cdr bm-current-book))
+	 (chapter (string-to-number (completing-read "Chapter: " (bm-list-number-range 1 book-chapters) nil t))))
+    (when chapter
+      (bm-set-location bm-current-book chapter))))
+
+;;;###autoload
+(defun bm-select-module ()
+  "Queries user to select a new reading module for the current `bible-mode' buffer."
+  (interactive)
+  (let ((module (completing-read "Module: " bm-modules)))
+    (setq-local bm-module module)
+    (bm-display)))
+
+;;;###autoload
+(defun bm-toggle-word-study()
+  "Toggles the inclusion of word study for the active `bible-mode' buffer."
+  (interactive)
+  (setq bm-word-study-enabled (not bm-word-study-enabled))
+  (if (equal major-mode 'bible-search-mode)
+      (bm-display-search bm-search-query bm-search-mode bm-module)
+    (bm-display)))
+
+;;;###autoload
+(defun bm-split-display ()
+  "Copies the active `bible-mode' buffer into a new buffer in another window."
+  (interactive)
+  (split-window-right)
+  (balance-windows)
+  (other-window 1)
+  (bible-open bm-current-book-name bm-current-chapter))
+
+;;;###autoload
+(defun bible-search (query)
+  "Prompts the user for a Bible search query: word or phrase and type of
+search: either `lucene' or `phrase'. `lucene' mode requires an index
+to be built using the `mkfastmod' program. `lucene' is the default
+search."
+  (interactive "sBible Search: ")
+  (when (> (length query) 0)
+    (let* ((searchmode (completing-read "Search Mode: " '("lucene" "phrase") nil t "lucene")))
+      (bm-open-search query searchmode))))
+
+;;;###autoload
+(defun bible-search-mode-follow-verse ()
+  "Follows the hovered verse in a `bible-search-mode' buffer,
+creating a new `bible-mode' buffer positioned at the specified verse."
+  (interactive)
+  (let* ((text (thing-at-point 'line t))
+         book
+         chapter
+         verse)
+    (string-match ".+ [0-9]?[0-9]?[0-9]?:[0-9]?[0-9]?[0-9]?:" text)
+    (setq text (match-string 0 text))
+    (string-match " [0-9]?[0-9]?[0-9]?:" text)
+    (setq chapter (replace-regexp-in-string "[^0-9]" "" (match-string 0 text)))
+    (string-match ":[0-9]?[0-9]?[0-9]?" text)
+    (setq verse (replace-regexp-in-string "[^0-9]" "" (match-string 0 text)))
+    (setq book (replace-regexp-in-string "[ ][0-9]?[0-9]?[0-9]?:[0-9]?[0-9]?[0-9]?:$" "" text))
+    (bible-open book (string-to-number chapter) (string-to-number verse))))
+
+;;;###autoload
+(defun bible-term-hebrew (term)
+  "Queries user for a Strong's Hebrew Lexicon term."
+  (interactive "sTerm: ")
+  (bm-open-term-hebrew term))
+
+;;;###autoload
+(defun bible-term-greek (term)
+  "Queries user for a Strong's Greek Lexicon term."
+  (interactive "sTerm: ")
+  (bm-open-term-greek term))
+
+;; (defun bible-term-morph (term morph-type)
+;;   "Queries user for a Strong's Greek Lexicon term."
+;;   (interactive "sTerm: ")
+;; ;;;  (message "bible-term-morph: %s:%s" term morph-type)
+;; ;;;  (bm-open-term-greek term)
+;;   )
+
+;;;###autoload
+(defun bible-insert ()
+  "Queries user to select a verse for insertion into the current buffer."
+  (interactive)
+  (let* ((completion-ignore-case t)
+	 (book-data (assoc (completing-read "Book: " bm-books nil t) bm-books))
+         (chapter (when book-data (completing-read "Chapter: " (bm-list-number-range 1 (cdr book-data)) nil t)))
+         (verse (when chapter (read-from-minibuffer "Verse: "))))
+    (when verse
+      (insert (string-trim
+	       (replace-regexp-in-string 
+		(regexp-opt `(,(concat "(" bm-module ")")))
+		"" 
+		(bm-exec-diatheke (concat (car book-data) " " chapter ":" verse) nil "plain")))))))
+
+;;;;; Support
+
+;;;
+;;; XXX I've magled this in an ad-hoc manner. It needs to be
+;;; re-written so it is clearer (and correct, for that matter).
+(defun bm-exec-diatheke (query &optional filter format searchtype module)
+  "Executes `diatheke' with specified query options, returning the output."
+  (let ((module (or module bm-module)))
+    (with-temp-buffer
+      (let ((args (list "diatheke" nil (current-buffer) t "-b" module)))
+	(if filter
+	    (setq filter (concat filter " avmws"))
+	    (setq filter "avmws"))
+	(when filter (setq args (append args (list "-o" filter))))
+	(when searchtype
+	  (setq args (append args (list "-s" (pcase searchtype ("lucene" "lucene") ("phrase" "phrase"))))))
+	(setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
+	(message "%s" args)
+	(apply 'call-process args))
+      (buffer-string))))
+
+(defvar-local bm-chapter-title nil
+  "Document text at start of chapter, mostly in Psalms, 
+like `Of David' or the like.")
+
+
+;;;
+;;; Greek and Hebrew lexicon and morphology tooltip rendering.
+;;;
+
+;;; Hash tables for STRONGS definitions.
+(defvar greek-hash (make-hash-table :test 'equal))
+(defvar hebrew-hash (make-hash-table :test 'equal))
+
+;;; Hash tables for morphologies. Three at present.
+(defvar robinson-hash (make-hash-table :test 'equal))
+(defvar packard-hash (make-hash-table :test 'equal))
+(defvar oshm-hash (make-hash-table :test 'equal))
+
+;;; Use HTMLHREF format with diatheke, post-process to render html.
+(defun bm-morph-query (query module)
+  "Executes `diatheke' to do morph query, renders HTML, returns string.
+Does some tweaking specific to morphology."
+  (with-temp-buffer
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
+      (apply 'call-process args)
+      (shr-render-region (point-min) (point-max))
+      (replace-regexp-in-string
+       "\n:" ""                   ; This makes the Packard morphology display look better.
+       (replace-regexp-in-string 
+	"Part of Speech" ""       ; This helps the Robinson display look better.
+	(substring (buffer-string) (+ (length query) 1)) ; This tries to get rid of unnecessary query identifier.
+	)))))
+
+
+;;; Use "plain" format with diatheke.
+(defun bm-lex-query (query module)
+  "Executes `diatheke' for query, plain format, returns string."
+  ;; Get rid of query ID at front of string: ?????:
+  (bm-exec-diatheke query nil "plain" nil module))
+
+(defun bm-lookup-strongs-greek (window object pos)
+  "Look up Greek lexical data for object at point. If not found in hash table,
+get it from sword database, stash in hash table, and return data.
+Note: compiler warns about unused argument `window'."
+  (let* ((query (get-text-property pos 'strong object))
+	 (match (string-match "[0-9]+" query))           ; Compiler warns about match.
+	 (lookup-key (match-string 0 query)))
+    (and lookup-key
+	 (or (gethash lookup-key greek-hash)
+	     (puthash lookup-key (bm-lex-query lookup-key bm-short-greek-lexicon) greek-hash)))))
+
+
+(defun bm-hebrew-lex-query (query module)
+  "Executes `diatheke' to do hebrew query, renders HTML, returns string."
+  (with-temp-buffer
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
+      (apply 'call-process args)
+      (shr-render-region (point-min) (point-max)))))
+
+(defun bm-lookup-strongs-hebrew (window object pos)
+  "Look up Hebrew lexical data for object at point. If not found in hash table,
+get it from sword database, stash in hash table, and return data.
+Note: compiler warns about unused `window' argument."
+  (let* ((query (get-text-property pos 'strong object))
+	 (match (string-match "[0-9]+" query))         ; Compiler warns about match.
+	 (lookup-key (match-string 0 query)))
+    (and lookup-key
+	 (or (gethash lookup-key hebrew-hash)
+	     ;; Use PLAIN format for lookup. XXX directionality problems.
+	     (puthash lookup-key (bm-lex-query lookup-key bm-short-hebrew-lexicon) hebrew-hash)))))
+
+(defun bm-morph-database-lookup (query database hash)
+  (or (gethash query hash)
+      (puthash query (bm-morph-query query database) hash)))
+
+(defun bm-show-lex-morph (window object pos)
+  (let* ((lex-morph-text "")
+	 (lex (get-text-property pos 'strong object))
+	 (lex-text
+	  (cond ((string-match "strong:G" lex)
+	   	 (bm-lookup-strongs-greek window object pos))
+		((string-match "strong:H" lex)
+		 (bm-lookup-strongs-hebrew window object pos)))))
+    (let* ((morph (get-text-property pos 'morph object))
+	   (morph-text
+	    (cond ((null morph) "")
+		  ((string-match "robinson:" morph)
+	   	   (bm-morph-database-lookup (replace-regexp-in-string "robinson:" "" morph) "Robinson" robinson-hash))
+		  ((string-match "packard:" morph)
+		   (bm-morph-database-lookup (replace-regexp-in-string "packard:" "" morph) "Packard" packard-hash))
+		  ((string-match "oshm:" morph)
+	   	   (bm-morph-database-lookup (replace-regexp-in-string "oshm:" "" morph) "OSHM" oshm-hash)))))
+      (when lex-text
+	(setq lex-morph-text lex-text))
+      (when morph-text
+	(setq lex-morph-text (concat lex-morph-text "\n" morph-text)))
+      ;; This prevents weird substitutions in the tooltip.
+      (propertize lex-morph-text 'help-echo-inhibit-substitution t)
+      lex-morph-text)))
+
+
+(defun bm-process-word (item iproperties)
+  "Word study. Add tooltips for definitions and morphologyl. 
+Insert lemmas in buffer. Must be done after item is inserted in buffer."
+
+  (let ((word (dom-text item))
+	(morph (dom-attr item 'morph))
+	(savlm (dom-attr item 'savlm))
+	(divinename (dom-by-tag item 'divinename)))
+
+    (insert word)
+
+    (let ((refstart (- (point) (length word)))
+	  (refend  (point)))
+
+      ;; Red letter
+      (when (plist-get iproperties 'jesus)
+	(add-face-text-property refstart refend '(:foreground "red")))
+
+      ;; Special case this. XXX Some modules do this differently.
+      (when divinename
+	(insert "LORD")
+	(let* ((refstart (- (point) (length "LORD")))
+	       (refend (point))
+	       (strongs (dom-attr item 'savlm)))
+	  (string-match "strong:H.*" strongs)
+	  (let ((strongs-ref (match-string 0 strongs)))
+	    (add-face-text-property refstart refend 'bold)
+      	    (put-text-property refstart refend 'keymap bm-hebrew-keymap)
+	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph)
+	    (put-text-property refstart refend 'strong strongs-ref))))
+
+      ;; lexical definitions
+      (when savlm
+	(let ((matched nil))
+	  (cond ((string-match "strong:G.*" savlm)        ; Greek
+		 (setq matched (match-string 0 savlm))
+		 (put-text-property refstart refend 'keymap bm-greek-keymap))
+		((string-match "strong:H.*" savlm)        ; Hebrew
+		 (setq matched (match-string 0 savlm))
+		 (put-text-property refstart refend 'keymap bm-hebrew-keymap)))
+	  ;; Add help-echo, strongs reference for tooltips if match.
+	  (when matched
+	    (setq-local bm-has-strongs t)
+	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph)
+	    (put-text-property refstart refend 'strong matched))))
+
+      ;; morphology
+      (when morph
+	(let ((matched nil))
+	  (cond ((string-match "robinson:.*" morph)    ; Robinson Greek morphology
+		 (setq matched (match-string 0 morph)))
+		((string-match "packard:.*" morph)     ; Packard Greek morphology --- LXX seems to use this
+		 (setq matched (match-string 0 morph)))
+		((string-match "oshm:.*" morph)        ; OSHM Hebrew morphology
+		 (setq matched (match-string 0 morph)))
+		(t nil
+		   ;;(message "Unknown morphology %s" morph)
+		   ))
+	  (when matched
+	    (setq-local bm-has-morphology t)
+	    (put-text-property refstart refend 'morph matched)
+	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph))))
+
+      ;; Insert lemma into buffer. Lemma tag will be part of savlm item.
+      (when (and bm-word-study-enabled savlm (string-match "lemma.*:.*" savlm))
+	(dolist (word (split-string (match-string 0 savlm) " "))
+	  (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
+	  (insert " " word)
+	  (let ((refstart (- (point) 1 (length word)))
+		(refend (point)))
+	    (add-face-text-property refstart refend '(:foreground "blue"))
+	    (put-text-property refstart refend 'keymap bm-lemma-keymap)))))))
+
+
+(defun bm-insert-domnode-recursive (node &optional iproperties notitle)
+  "Recursively parses a domnode from `libxml-parse-html-region's usage on text
+produced by `bm-exec-diatheke'. Outputs text to active buffer 
+with properties.
+In processing subnodes, each case will prepend a space if it needs it."
+
+  (if (and bm-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
+      ;; For red-letter display.
+      (setq iproperties (plist-put iproperties 'jesus t))
+    (setq iproperties nil))
+
+;;  (when (equal (dom-tag node) 'title)
+;;    ;; Space one line down so there's room for the title at the beginning.
+;;    (insert "\n"))
+
+  (dolist (subnode (dom-children node))
+    (cond ((null subnode) nil)
+	  ((stringp subnode)
+	   ;; Insert the subnode. Highlight the verse references.
+	   (insert subnode)
+	   ;; XXX this is still not quite right
+	   (let ((verse-start (string-match ".+?:[0-9]?[0-9]?[0-9]?:" subnode)))
+	     (when verse-start
+	       (let* ((verse-match (string-trim (match-string 0 subnode)))
+		      (verse-start-text (string-trim-left (substring subnode verse-start (length subnode))))
+		      (subnode (concat (substring subnode 0 verse-start) verse-start-text))
+		      (start (- (point) 1 (length (string-trim-right verse-start-text)))))
+		 (add-face-text-property start (+ start (length (string-trim-right verse-match))) '(:foreground "purple"))))))
+	  ((eq (dom-tag subnode) 'title)
+	   (if notitle nil
+	     (progn
+	       (setq bm-chapter-title subnode))))
+	  ((eq (dom-tag subnode) 'body) (bm-insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'seg) ; NASB Module uses this to indicate OT quotations (and others?).
+	   (bm-insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'q) (bm-insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'p) (bm-insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'w) (insert " ") (bm-process-word subnode iproperties))
+	  ((eq (dom-tag subnode) 'milestone) (insert "\n"))
+	  ((eq (dom-tag subnode) 'transchange) ; Word inserted by translation, not in original, give visual indication.
+	   (let ((word (dom-text subnode)))
+	     (insert " " word)
+	     (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))
+
+
+(defvar bm-debugme nil)
+(setf bm-debugme nil)
+
+(defun bm-display (&optional verse)
+  "Renders text for `bible-mode'"
+
+  ;; Clear buffer and insert the result of calling bm-exec-diatheke.
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (setq bm-chapter-title nil
+	bm-has-strongs nil
+	bm-has-morphology nil)
+  (insert (bm-exec-diatheke (concat bm-current-book-name ":" (number-to-string bm-current-chapter))))
+
+  ;; Parse the xml in the buffer into a DOM tree.
+  (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
+    ;; Render the DOM tree into the buffer.
+    (if (not bm-debugme)
+	(progn
+	  (erase-buffer)
+	  ;; Looking for the "body" tag in the DOM node.
+	  (bm-insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	  (goto-char (point-min)))
+;;;      (shr-render-region (point-min) (point-max))
+      ))
+
+  ;; Remove the module name from the buffer.
+  (while (search-forward (concat "(" bm-module ")") nil t)
+    (replace-match ""))
+
+  ;; Set the mode line of the biffer.
+  (setq mode-name (concat "Bible (" 
+			  bm-module
+			  (when bm-has-strongs " Lex")
+			  (when bm-has-morphology " Morph")
+			  ")"))
+
+  ;; Deal with chapter titles (i.e. in Psalms)
+  ;; 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".
+  (when bm-chapter-title  ; This gets set in bm-insert-domnode-recursive.
+    (goto-char (point-min))
+    (let ((title-text (dom-texts bm-chapter-title))
+	  (refstart (point-min))
+	  refend)
+      ;; Insert and make bold the title.
+      (when (string-or-null-p title-text)
+	  (insert title-text "\n")
+	  (setq refend (point))
+	  (put-text-property refstart refend 'face 'bold))))
+
+  (setq buffer-read-only t)
+  (goto-char (point-min))
+
+  ;; If optional verse specification go to that verse.
+  (when verse
+    (goto-char (string-match (regexp-opt `(,(concat ":" (number-to-string verse) ":"))) (buffer-string)))
+    (beginning-of-line)))
+
+
+(defun bm-list-biblical-modules ()
+  "Returns a list of accessible Biblical Text modules."
+  (let ((text (bm-exec-diatheke "modulelist" nil nil nil "system"))
+	modules)
+    (catch 'done
+      (dolist (line (split-string text "\n"))
+	(when (equal line "Commentaries:")
+          (throw 'done nil))
+	(when (not (equal "Biblical Texts:" line))
+          (push (split-string line " : ") modules))))
+    modules))
+
+(defun bm-pick-module ()
+  (interactive)
+  (message "Picking module at %s" (point))
+  (let ((item (get-text-property (point) 'module)))
+    (setq-default bm-module item)
+    (bible-open)))
+    
+
+(defconst bm-module-map (make-keymap))
+(define-key bm-module-map [mouse-1] 'bm-pick-module)
+
+
+(defun bm-display-available-modules ()
+  (interactive)
+  (let ((buf (get-buffer-create "Modules"))
+	(mods (bm-list-biblical-modules)))
+    (set-buffer buf)
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (dolist (mod mods)
+      (insert 
+       (propertize (car mod) 
+		   'face 'bold 
+		   'module (car mod)
+		   'help-echo (concat "Select " (car mod))
+		   'keymap bm-module-map)
+       "\t\t"
+       (format "%s\n" (cadr mod))))
+    (setq buffer-read-only t)
+    (pop-to-buffer buf)))
+
+
+
+;;;;; Bible Searching
+
+(defun bm-open-search (query searchmode)
+  "Opens a search buffer of QUERY using SEARCHMODE."
+  (let ((buf (get-buffer-create (concat "*bible-search-" (downcase bm-module) "-" query "*"))))
+    (set-buffer buf)
+    (bible-search-mode)
+    (bm-display-search query searchmode bm-module)
+    (pop-to-buffer buf nil t)))
+
+(defun bm-display-search (query searchmode mod)
+  "Renders results of search QUERY from SEARHCMODE"
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  
+  (let* ((result (string-trim (replace-regexp-in-string 
+			       "Entries .+?--" "" 
+			       (bm-exec-diatheke query nil "plain" searchmode mod))))
+	 (match 0)
+	 (matchstr "")
+	 (verses "")
+	 fullverses)
+    (if (equal result (concat "none (" bm-module ")"))
+	(insert "No results found." (when (equal searchmode "lucene") " Verify index has been build with mkfastmod."))
+      (progn
+	(while match
+	  (setq match (string-match ".+?:[0-9]?[0-9]?" result (+ match (length matchstr)))
+		matchstr (match-string 0 result))
+	  (when match
+            (setq verses (concat verses (replace-regexp-in-string ".+; " "" matchstr) ";"))))
+
+	(setq match 0)
+	(setq fullverses (bm-exec-diatheke verses))
+
+	(insert fullverses)
+	(sort-lines nil (point-min) (point-max))
+	    
+	(let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
+	  (erase-buffer)
+	  (bm-insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	  (goto-char (point-min))
+	  (while (search-forward (concat "(" bm-module ")") nil t)
+	    (replace-match "")))))
+
+    (setq mode-name (concat "Bible Search (" bm-module ")"))
+    (setq buffer-read-only t)
+    (setq-local bm-search-query query)
+    (setq-local bm-search-mode searchmode)
+    (goto-char (point-min))))
+
+;;;;; Terms
+
+
+;;(defun bm-display-morphology (morph)
+;; ;; xxx Do something here?
+;;  )
+
+(defun bm-display-term (termtype)
+  (cl-do* ((text (buffer-string))
+           (match (string-match "[0-9]+" text) (string-match "[0-9]+" text (match-end 0))))
+      ((not match))
+    (let* ((matchstr (match-string 0 text))
+	   (matchstrlen (length matchstr))
+           (refstart (+ match 1))
+           (refend (+ match 1 matchstrlen)))
+      ;; This enables clicking on the Strong's numbers inside the term display.
+      (add-face-text-property refstart refend `(:foreground "blue"))
+      (cond ((eq termtype 'hebrew)
+	     (put-text-property refstart refend 'strong (concat "strong:H" matchstr))
+	     (put-text-property refstart refend 'keymap bm-hebrew-keymap))
+	    ((eq termtype 'greek)
+	     (put-text-property refstart refend 'strong (concat "strong:G" matchstr))
+	     (put-text-property refstart refend 'keymap bm-greek-keymap)))))
+  (goto-char (point-min))
+  (while (search-forward (concat "(" bm-module ")") nil t)
+    (replace-match ""))
+  (while (search-forward "()" nil t)
+    (replace-match ""))
+  (goto-char (point-min))
+  (setq buffer-read-only t))
+
+(defun bm-open-term-hebrew (term)
+  "Opens a buffer of the Strong's Hebrew TERM's definition"
+  (let ((buf (get-buffer-create (concat "*bible-term-hebrew-" term "*"))))
+    (set-buffer buf)
+    (bible-term-hebrew-mode)
+    (bm-display-term-hebrew term)
+    (pop-to-buffer buf nil t)
+    (fit-window-to-buffer)))
+
+(defun bm-open-term-greek (term)
+  "Opens a buffer of the Strong's Greek TERM's definition"
+  (let ((buf (get-buffer-create (concat "*bible-term-greek-" term "*"))))
+    (set-buffer buf)
+    (bible-term-greek-mode)
+    (bm-display-term-greek term)
+    (pop-to-buffer buf nil t)
+    (fit-window-to-buffer)))
+
+;;;
+;;; Note: Hebrew display of terms is backwards; set bidi direction to
+;;; 'left-to-right.
+(defun bm-display-term-hebrew (term)
+  "Render the definition of the Strong's Hebrew TERM. Use
+bidi-paragraph-direction so the English text will render
+left-to-right. XXX Why doesn't this work for the tooltips?"
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (insert (replace-regexp-in-string
+	   (regexp-opt `(,bm-hebrew-lexicon))
+	   ""
+	   (bm-exec-diatheke term nil "plain" nil bm-hebrew-lexicon)
+	   nil nil nil 7
+	   ))
+  (bm-display-term 'hebrew)
+  (setq bidi-paragraph-direction 'left-to-right))
+
+
+(defun bm-display-term-greek (term)
+  "Render the definition of the Strong's Greek TERM."
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (insert (replace-regexp-in-string
+	   (regexp-opt `(,bm-greek-lexicon))
+	   "" 
+	   (bm-exec-diatheke term nil "plain" nil bm-greek-lexicon)
+	   nil nil nil 7
+	   ))
+  ;;  (insert "\n")
+  (bm-display-term 'greek))
+
+
+(defun bm-set-location (book chapter &optional verse)
+  "Sets the global chapter of the active `bible-mode' buffer."
+  (setq-local bm-current-book book)
+  (setq-local bm-current-book-name (car book))
+  (setq-local bm-current-chapter chapter)
+  (bm-display verse))
+
+;;;;; Utilities
+
+(defun bm-list-number-range (min max &optional prefix)
+  "Returns a list containing entries for each integer between min and max.
+Used in tandem with `completing-read' for chapter selection."
+  (let ((range-list nil))
+    (dotimes (num (1+ max))
+      (when (>= num min)
+	(push (cons (concat prefix (number-to-string num)) num) range-list)))
+    (nreverse range-list)))
+
+
+;;; Provides
+
+(provide 'bible-mode)
+
+;; Local Variables:
+;; read-symbol-shorthands: (("bm-" . "bible-mode-"))
+;; End: