bible-mode/bible-mode.el

;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
;;
;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI

;; Author: Zacalot
;; Substantial fixes and modifications by Fred Gilham
;; Url: https://gitbot.homedns.org/fred/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-"
;;; Names of the form "bm--" are intended to be "unexported".

;;; Code:

;;;; Requirements
;;; XXX FMG there are just a few constructs that use this; use elisp versions instead.
;;(require 'cl-lib) 
(require 'dom)
(require 'shr)

;; Turn off tool bar mode because we want the pixels....
(tool-bar-mode -1)

;;;; Variables

(defgroup bible-mode nil
  "Settings for `bible-mode'."
  :group 'tools
  :link '(url-link "https://gitbot.homedns.org/fred/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)

;;;
;;; XXX Not implememted yet
(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
  "AbbottSmithStrongs"
  "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-use-index-for-lexicon nil
  "Some lexicons are accessed by lemmas rather than Strong's numbers. 
Use an index to look up lemmas from Strong's numbers so these lexicons can
be used. Examples of this type of lexicon are AbbottSmith and
LiddellScott. XXX LiddellScott currently doesn't work. XXX AbbottSmithStrongs
now has the complete entries instead of just links."
  
  :type 'boolean
  :local nil
  :group 'bible-mode)

(defcustom bm-lexicon-index "AbbottSmithStrongs"
  "A module that consists of an index mapping Strong's numbers to Greek lemmas. 
The code is written to use the entries in AbbottSmithStrongs
which are of the form

<strong's number>: @LINK <greek lemma>"
  :type '(string :tag "Lexicon index.")
  :local nil
  :group 'bible-mode)


(defcustom bm-greek-lexicon-short
  "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"
  "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-hebrew-lexicon-short
  "BDBGlosses_Strongs" ; This seems to work
  "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)

(defcustom bm-show-diatheke-exec
  t
  "Show the arguments by which diatheke is executed."
  :type 'boolean
  :local nil
  :group 'bible-mod)

;;; variable defs

;;(defvar bm-verse-regexp "([\d ]*[a-zA-Z]+( \d*:\d*)?)(( - )| )?(((\d* )?[a-zA-Z]+ )?\d*([:-]+\d*)?)")
;; (defvar bm-verse-regexp "/(\d*)\s*([a-z]+)\s*(\d+)(?::(\d+))?(\s*-\s*(\d+)(?:\s*([a-z]+)\s*(\d+))?(?::(\d+))?)?/i")
(defconst bm-verse-regexp "\\(I \\|II \\|III \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")


(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.")

(defvar bm-book-name-abbreviations-alist
  '(;; Old Testament
    ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
    ("De"     . "Deuteronomy")     ("Js"    . "Joshua")           ("Jg"   . "Judges")        ("Ru"    . "Ruth")
    ("I Sa"   . "I Samuel")        ("II Sa" . "II Samuel")        ("I Ki" . "I Kings")       ("II Ki" . "II Kings") 
    ("I Ch"   . "I Chronicles")    ("II Ch" . "II Chronicles")    ("Ezr"  . "Ezra")          ("Ne"    . "Nehemiah")
    ("Es"     . "Esther")          ("Jb"    . "Job")              ("Ps"   . "Psalms")        ("Pr"    . "Proverbs")
    ("Ec"     . "Ecclesiastes")    ("So"    . "Song of Solomon")  ("Is"   . "Isaiah")        ("Je"    . "Jeremiah")
    ("La"     . "Lamentations")    ("Ez"    . "Ezekiel")          ("Da"   . "Daniel")        ("Ho"    . "Hosea") 
    ("Joe"    . "Joel")	           ("Am"    . "Amos")             ("Ob"   . "Obadiah")       ("Jon"   . "Jonah")
    ("Mi"     . "Micah")           ("Na"    . "Nahum")            ("Ha"   . "Habakkuk")      ("Zep"   . "Zephaniah")     
    ("Hag"    . "Haggai")          ("Ze"    . "Zechariah")        ("Mal"  . "Malachi")
    ;; New Testament
    ("Mt"     . "Matthew")         ("Mk"    . "Mark")             ("Lk"   . "Luke")          ("Jo"    . "John")
    ("Ac"     . "Acts")            ("Ro"    . "Romans")           ("I Co" . "I Corinthians") ("II Co" . "II Corinthians")
    ("Ga"     . "Galatians")       ("Eph"   . "Ephesians")	  ("Phl"  . "Philippians")   ("Col"   . "Colossians")
    ("I Th"   . "I Thessalonians") ("II Th" . "II Thessalonians") ("I Ti" . "I Timothy")     ("II Ti" . "II Timothy")
    ("Tit"    . "Titus")           ("Phm"   . "Philemon")	  ("He"   . "Hebrews")       ("Ja"    . "James")
    ("I Pe"   . "I Peter")         ("II Pe" . "II Peter")	  ("I Jo" . "I John")        ("II Jo" . "II John")
    ("III Jo" . "III John")        ("Ju"    . "Jude")             ("Re"   . "Revelation of John"))
  "A-list of abbreviations 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-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-sparse-keymap)
  "Keymap for bible-mode.")
(define-key bm-map [menu-bar bible-mode]
	    (cons "Bible Mode" (make-sparse-keymap "Bible Mode")))

(define-key bm-map
	    [menu-bar bible-mode toggle-debug]
	    '("Toggle debug-on-error" . toggle-debug-on-error))


(defun bm-toggle-display-diatheke ()
  "Toggle XML display."
  (interactive)
  (setq bm-show-diatheke-exec (not bm-show-diatheke-exec)))

(define-key bm-map
	    [menu-bar bible-mode display-diatheke]
	    '("Toggle diatheke display" . bm-toggle-display-diatheke))

(defun bm-toggle-display-xml ()
  "Toggle XML display."
  (interactive)
  (setq-local bm-debugme (not bm-debugme))
  (bm--display))

(define-key bm-map "d" 'bm-toggle-display-xml)
(define-key bm-map 
	    [menu-bar bible-mode display-xml]
	    '("Toggle XML Display" . bm-toggle-display-xml))

(define-key bm-map
	    [menu-bar bible-mode sep]
	    '(menu-item '"--"))


;;;;; Navigation
(define-key bm-map "n" 'bm-next-chapter)
(define-key bm-map
	    [menu-bar bible-mode next-chapter]
	    '("Next Chapter" . bm-next-chapter))
	    
(define-key bm-map "p" 'bm-previous-chapter)
(define-key bm-map
	    [menu-bar bible-mode previous-chapter]
	    '("Previous Chapter" . bm-previous-chapter))

(define-key bm-map (kbd "TAB") 'bm-next-word)
(define-key bm-map (kbd "M-<tab>") 'bm-previous-word)

;;;;; Direct jump
(define-key bm-map "b" 'bm-select-book)
(define-key bm-map
	    [menu-bar bible-mode select-book]
	    '("Select Book" . bm-select-book))

(define-key bm-map "c" 'bm-select-chapter)
(define-key bm-map
	    [menu-bar bible-mode select-chapter]
	    '("Select Chapter" . bm-select-chapter))

;;;;; Search
(define-key bm-map "/" 'bible-search)
(define-key bm-map "s" 'bible-search)
(define-key bm-map
	    [menu-bar bible-mode search]
	    '("Bible Search" . 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 "r" 'bm-toggle-red-letter)

(define-key bm-map "x" 'bm-split-display)
(define-key bm-map
	    [menu-bar bible-mode split-display]
	    '("Split Display" . bm-split-display))

(define-key bm-map
	    [menu-bar bible-mode sep]
	    '(menu-item '"--"))


;;;;; Deal with visual-line-mode
(define-key bm-map "\C-n" 'next-logical-line)
(define-key bm-map "\C-p" 'previous-logical-line)

(defun bm-next-search-item ()
  (interactive)
  (search-forward-regexp bm-verse-regexp))

(defun bm-previous-search-item ()
  (interactive)
  (search-backward-regexp bm-verse-regexp))


(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 "n" 'bm-next-search-item)
(define-key bible-search-mode-map "p" 'bm-previous-search-item)
(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)

(defconst bible-term-hebrew-mode-map (make-sparse-keymap))
(defconst bible-term-greek-mode-map (make-sparse-keymap))

(define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)

;;;
;;; Menu bar items
;;;

(defvar-local bm-text-direction 'left-to-right)

(defun bm-toggle-text-direction ()
  (interactive)
  (if (eq bm-text-direction 'left-to-right)
      (setq-local bm-text-direction 'right-to-left)
    (setq-local bm-text-direction 'left-to-right))
  (setq-local bidi-paragraph-direction bm-text-direction))

(defvar-local bm-debugme nil
  "Make text show up as XML when set.")

(defvar use-tooltips t)

(defun bm-toggle-tooltips ()
  "Toggle use of tooltips to display lexical/morphological items."
  (interactive)
  (setq use-tooltips (not use-tooltips))
  (tooltip-mode 'toggle)
  (setq tooltip-resize-echo-area use-tooltips))



(define-key bm-map
	    [menu-bar bible-mode sepp]
	    '(menu-item '"--"))

(define-key bm-map
	    [menu-bar bible-mode toggle-text-direction]
	    '("Toggle text direction (for Hebrew display)" . bm-toggle-text-direction))

(define-key bm-map
	    [menu-bar bible-mode toggle-tooltip-display]
	    '("Toggle Tooltip Display" . bm-toggle-tooltips))

(define-key bm-map
	    [menu-bar bible-mode sepp]
	    '(menu-item '"--"))

(define-key bm-map
	    [menu-bar bible-mode select-biblical-text]
	    '("Select Module" . bm-display-available-modules))

(defun bm--display-greek ()
  "This command is run by clicking on text, not directly by the user."
  (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 () 
  "This command is run by clicking on text, not directly by the user."
  (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 "strong:H" "" item))))

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

(define-derived-mode module-select-mode special-mode "Select Text Module"
  (buffer-disable-undo)
  (font-lock-mode t)
  (setq buffer-read-only t))


;;;; Functions

;;;;; Commands

;;;###autoload
(defun bible-open (&optional book-name chapter verse)
  "Create and open a `bible-mode' buffer. 
Arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the starting
verse reference for the buffer. If no optional arguments are supplied, 
Genesis 1:1 is used."
  (interactive)
  (let ((buf (get-buffer-create (generate-new-buffer-name (concat "*bible*")))))
    (set-buffer buf)
    (bible-mode)
    (bm--set-location (or (assoc (or book-name "Genesis") bm-books) (list book-name)) (or chapter 1) verse)
    (set-window-buffer (get-buffer-window (current-buffer)) buf)))

;;;###autoload
(defun bm-next-chapter ()
  "Page 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 ()
  "Page 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-next-word ()
  "Move forward a word, taking into account the relevant text properties."
  (interactive)
  (unless (eobp)
    (let ((next-change (text-property-search-forward 'strong nil nil t)))
      (when next-change
	(goto-char (1- (prop-match-end next-change)))))))

(defun bm-previous-word ()
  "Move back a word, taking into account the relevant text properties."
  (interactive)
  (unless (bobp)
    (let ((previous-change (text-property-search-backward 'strong)))
      (when previous-change
	(goto-char (prop-match-beginning previous-change))))))



;;;###autoload
(defun bm-select-book ()
  "Ask user for 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 ()
  "Ask user for 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 ()
  "Ask user for a new text 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()
  "Toggle 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)))

(defun bm-toggle-red-letter()
  "Toggle red letter mode for the active `bible-mode' buffer."
  (interactive)
  (setq bm-red-letter-enabled (not bm-red-letter-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 ()
  "Copy 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 bm-module))))

;;;###autoload
(defun bible-search-mode-follow-verse ()
  "Follow the hovered verse in a `bible-search-mode' buffer.
Create a new `bible-mode' buffer positioned at the selected 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 (string-trim book) (string-to-number chapter) (string-to-number verse))))

(defun bible-search-mode-follow-xref ()
  "Follow the hovered verse in a bible term buffer.
Create a new `bible-mode' buffer positioned at the specified verse.
XXX We use the current module to avoid opening cans of worms regarding
OT/NT etc. If that module doesn't have that verse...???"
  (interactive)
  (let* ((xref (get-text-property (point) 'xref))
	 (verse-ref (string-split xref))
	 book-abbrev
	 book
	 chapter-verse
	 chapter
	 verse)
    (if (= (length verse-ref) 3) ; II Cor 3:17 or the like
	(progn
	  (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref)))
	  (setq chapter-verse (split-string (caddr verse-ref) ":")))
      (progn  ; Mat 5 or the like
	(setq book-abbrev (car verse-ref))
	(setq chapter-verse (split-string (cadr verse-ref) ":"))))

    ;;    (setq book (cdr (assoc book-abbrev bm-book-name-abbreviations-alist)))
    (setq book (car verse-ref))
    (setq chapter (car chapter-verse)
	  verse (cadr chapter-verse))
    (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))

;;;###autoload
(defun bible-term-hebrew (term)
  "Query user for a Strong's Hebrew Lexicon TERM."
  (interactive "sTerm: ")
  (bm--open-term-hebrew term))

;;;###autoload
(defun bible-term-greek (term)
  "Query user for a Strong's Greek Lexicon TERM."
  (interactive "sTerm: ")
  (bm--open-term-greek term))

;;;###autoload
(defun bible-insert ()
  "Query 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


(defconst diatheke-filter-options " avlnmw")
;;;
;;; XXX I've mangled 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)
  "Execute `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 diatheke-filter-options))
	    (setq filter diatheke-filter-options))
	(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)))
	(when bm-show-diatheke-exec
	  (message "%s" args))
	(apply 'call-process args))
      (buffer-string))))

(defvar-local bm-chapter-title nil
  "Text preceding start of chapter.
Mostly in Psalms, like `Of David' or the like.")


;;;
;;; Greek and Hebrew lexicon and morphology tooltip rendering.
;;;

;;; Hash tables for Lexical definitions.
(defvar greek-hash (make-hash-table :test 'equal))
(defvar greek-hash-short (make-hash-table :test 'equal))
(defvar hebrew-hash (make-hash-table :test 'equal))
(defvar hebrew-hash-short (make-hash-table :test 'equal))

;; Do lookups using index to lexicon with lookups by lemma.
(defvar lemma-index-hash (make-hash-table :test 'equal))
(defvar lemma-lex-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)
  "Execute `diatheke' to do morph QUERY, using MODULE.
Render HTML, return string. Do some tweaking specific to morphology."
  (with-temp-buffer
    (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
      (when bm-show-diatheke-exec
	(message "%s" args))
      (apply 'call-process args)
      (shr-render-region (point-min) (point-max))
      (format-replace-strings 
       '(("\n:" . "")              ; This makes the Packard morphology display look better.
	 ("Part of Speech" . ""))     ; This helps the Robinson display look better.
	 nil (point-min) (point-max))
      (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)
  "Execute `diatheke' for QUERY, using MODULE.
Plain format, returns string."
  ;; Get rid of query ID at front of string: ?????:
  (bm--exec-diatheke query nil "plain" nil module))

(defun bm--lookup-lemma-index (key)
  "Given a strong's number KEY, return the Greek lemma from lemma index."
  (or (gethash key lemma-index-hash)
      (puthash key 
	       (string-trim 
		(replace-regexp-in-string
		 (concat "(" bm-lexicon-index ")") "" 
		 (bm--lex-query key bm-lexicon-index)))
	       lemma-index-hash)))

;;;
;;; The Greek lexical definitions are done using the HTMLHREF output
;;; format so they come out looking nice and having clickable
;;; cross-references and/or Strong's references.
	   
(defun bm--process-href ()
  "Fix the XML so cross-references are in the right format. 
These cross-references get processed later when the term is displayed.

First, find the links put in by diatheke's HTMLHREF output format.
Replace the links with verse references that get changed to clickable
cross-references when the term is displayed. 

The verse refs look like this: <bookname>.<chapter>.<verse>. We convert
them to the <bookname> <chapter>:<verse> format."

  (goto-char (point-min))

  (while (re-search-forward "<a href=\"passagestudy.*?</a>" nil t) ; HTMLHREF cross references.

    (let ((match-text (match-string 0)))

      ;; Delete original link.
      (replace-match "" nil nil)
      
      ;; Get the verse reference from the string we saved. Put it in
      ;; good format, then insert it into buffer where href was.

      (when (string-match "value=.*?&" match-text)
	(let* ((value-string (match-string 0 match-text))
	       ;; Strip off value= and trailing &.
	       (verse-ref-string (substring value-string 6 (1- (length value-string))))
	       (verse-ref-length (length verse-ref-string))
	       period)

	  ;; Convert periods
	  ;; Substitute first period with space
	  (when (setq period (cl-search "." verse-ref-string))
	    (aset verse-ref-string period ? ))
	  ;; Substitute second period with colon
	  (when (setq period (cl-search "." verse-ref-string))
	    (aset verse-ref-string period ?:))

	  ;; Replace numbers (1, 2 or 3) with roman numerals (I, II, III) XXX Fix?
	  (pcase (aref verse-ref-string 0)
	    (?1 (setq verse-ref-string (concat "I" (substring verse-ref-string 1))))
	    (?2 (setq verse-ref-string (concat "II" (substring verse-ref-string 1))))
	    (?3 (setq verse-ref-string (concat "III" (substring verse-ref-string 1)))))

	  (set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
	  (insert verse-ref-string))))))

(defun bm--lookup-greek-def (key)
  "Execute `diatheke' to do query on KEY.
Massage output so verse cross references are usable. Returns string.
We use HTMLHREF format output because it may have verse references
as HTML links, depending on the lexicon module."

  (with-temp-buffer
    (let ((args (list "diatheke" nil (current-buffer) t "-b" bm-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" key)))
      ;; XXX Change to OSIS? Need to parse OSIS-style references.
;;;    (let ((args (list "diatheke" nil (current-buffer) t "-b" bm-greek-lexicon "-o" "m" "-f" "OSIS" "-k" key)))
      (when bm-show-diatheke-exec
	(message "%s" args))
      (apply 'call-process args)
      (bm--process-href)    ; Clean up XML so xrefs can work after rendering.
      (shr-render-region (point-min) (point-max))
      (buffer-string))))

(defun bm--lookup-lex-greek-indexed (key)
  "Get Greek lemma using Strong's number KEY.
Then look up the definition of that lemma. Used when two-stage 
lexical definition is set for a particular lexicon."
  (let ((lemma-entry (bm--lookup-lemma-index key))) ; Get lemma from Strong's number
    (when lemma-entry
      (let ((lemma (caddr (split-string lemma-entry " "))))
	(bm--lookup-greek-def lemma)))))


(defun bm--lookup-lex-greek (key)
  "Lookup lexical definition using Strong's number KEY.
1. Check hash table first. If entry found, return.
2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
3. Otherwise just use the Strong's number method."
  (or (gethash key greek-hash)
      (puthash key
	       (if bm-use-index-for-lexicon
		   (bm--lookup-lex-greek-indexed key)
		 (bm--lookup-greek-def key))
	       greek-hash)))

(defun bm--lookup-strongs-greek (window object pos)
  "Look up Greek lexical entry of OBJECT clicked on in WINDOW at POS.
If not found in hash table, get it from sword database. stash in hash
table, and return string.
Note: compiler warns about unused `WINDOW' argument."
  (let ((query (get-text-property pos 'strong object)))  ; Get Strong's number from text property
    (when (string-match "[0-9]+" query)
      (bm--lookup-lex-greek (match-string 0 query)))))


(defun bm--lookup-strongs-greek-short (window object pos)
  "Look up shorter Greek lexical entry of OBJECT clicked on in WINDOW at POS.
If not found in hash table, get it from sword database, stash in hash table, 
and return string.
Note: compiler warns about unused `window' argument."
  (let ((query (get-text-property pos 'strong object)))  ; Get Strong's number from text property
    (when (string-match "[0-9]+" query)
      (let ((lookup-key (match-string 0 query)))
	(or (gethash lookup-key greek-hash-short)
	    (let ((raw-text (bm--lex-query lookup-key bm-greek-lexicon-short)))
	      (puthash lookup-key raw-text greek-hash-short)))))))


(defun bm--lookup-strongs-hebrew (window object pos)
  "Look up Hebrew lexical string for object at point. 
If not found in hash table, get it from sword database, 
stash in hash table, and return string.
Note: compiler warns about unused `window' argument."
  (let ((query (get-text-property pos 'strong object)))
    (when (string-match "[0-9]+" query)
      (let ((lookup-key (concat "H" (match-string 0 query))))
	(or (gethash lookup-key hebrew-hash)
	    (let ((raw-text (bm--lex-query lookup-key bm-hebrew-lexicon)))
	      (puthash lookup-key raw-text hebrew-hash)))))))

(defun bm--lookup-strongs-hebrew-short (window object pos)
  "Look up Hebrew lexical string from short Hebrew lexicon for object
at point. If not found in hash table, get it from sword database, 
stash in hash table, and return string.
Note: compiler warns about unused `window' argument."
  (let ((query (get-text-property pos 'strong object)))
    (when (string-match "[0-9]+" query)
      (let ((lookup-key (concat "H" (match-string 0 query))))
	(or (gethash lookup-key hebrew-hash-short)
	    (let ((raw-text (bm--lex-query lookup-key bm-hebrew-lexicon-short)))
	      (puthash lookup-key raw-text hebrew-hash-short)))))))

(defun bm--morph-database-lookup (query database hash)
  (or (gethash query hash)
      (puthash query (bm--morph-query query database) hash)))

(defvar bm-outline-strings
  '((" I." .  "\n    I.")
    (" 1." . "\n 1.")
    (" 2." . "\n 2.")
    (" 3." . "\n 3.")
    (" a." . "\n   a.")
    (" b." . "\n   b.")
    (" c." . "\n   c.")    
    (". ." . ".")
    (" . " . ". ")))

(defun bm-cleanup-tooltip-text (lex-text)
  (dolist (outline-string bm-outline-strings)
    (setq lex-text (string-replace (car outline-string) (cdr outline-string) lex-text)))
    lex-text)

;;;
;;; Get string for tooltip display
;;;
(defun bm--show-lex-morph (window object pos)
  "Get text for tooltip display. Includes both lex and morph 
definitions if text module has both tags, otherwise just get 
lex definition."
  (let* ((lex-morph-text "")
	 (lex (get-text-property pos 'strong object))
	 (lex-module nil)
	 (lex-text
	  (cond ((string-match "strong:G" lex)
		 (bm--lookup-strongs-greek-short window object pos))
		((string-match "strong:H" lex)
		 (bm--lookup-strongs-hebrew-short window object pos)))))
    (setq lex-text (string-replace (concat "(" lex-module ")") "" lex-text))
    (let* ((morph (get-text-property pos 'morph object))
	   (morph-module nil)
	   (morph-text
	    (cond ((null morph) nil)
		  ((string-match "robinson:" morph)
		   (setq morph-module "Robinson")
	   	   (bm--morph-database-lookup (replace-regexp-in-string "robinson:" "" morph) morph-module robinson-hash))
		  ((string-match "packard:" morph)
		   (setq morph-module "Packard")
		   (bm--morph-database-lookup (replace-regexp-in-string "packard:" "" morph) morph-module packard-hash))
		  ((string-match "oshm:" morph)
		   (setq morph-module "OSHM")
	   	   (bm--morph-database-lookup (replace-regexp-in-string "oshm:" "" morph) morph-module oshm-hash)))))
      (when lex-text
	(setq lex-morph-text (string-trim (bm-cleanup-tooltip-text (string-fill lex-text 75)))))
      (when morph-text
	(setq lex-morph-text 
	      (concat lex-morph-text "\n\n"
		      (string-trim (string-replace (concat "(" morph-module ")") "" morph-text)))))
      ;; This prevents bogus command substitutions in the tooltip by
      ;; removing backslashes. XXX I couldn't figure out a better way
      ;; to bypass command substitution in the tooltips.
      (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text)))))


(defun bm-handle-divine-name (item)
  (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 bm-hebrew-keymap)
    (when (and strongs (string-match "strong:H.*" strongs))
      (put-text-property refstart refend 'help-echo 'bm--show-lex-morph)
      (put-text-property refstart refend 'strong (match-string 0 strongs)))))


(defun bm--process-word (item iproperties)
  "Handle <w ....> fubar </w> tag. Add tooltips for definitions and morphology. 
Also insert lemmas in buffer (must be done after item is inserted in
buffer)."
  (let ((word (string-trim (dom-text item)))
	(morph (dom-attr item 'morph))
	(savlm (dom-attr item 'savlm))
	(lemma (dom-attr item 'lemma))
	(divinename (dom-by-tag item 'divinename)))

    (insert word)

    (let ((refstart (- (point) (length word)))
	  (refend  (point)))

      ;; Red letter (Yuck, some modules need this below)
      (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 " ")
	(bm-handle-divine-name item))

      ;; lexical definitions
      (when (or savlm lemma)
	(let ((matched nil)
	      (item (or savlm lemma)))
	  (cond ((string-match "strong:G.*" item)        ; Greek
		 (setq matched (match-string 0 item))
		 (put-text-property refstart refend 'keymap bm-greek-keymap))
		((string-match "strong:H.*" item)        ; Hebrew
		 (setq matched (match-string 0 item))
		 (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.
      ;; XXX Should I do lexicon lookups on these lemmas? I don't use
      ;; this anyway....
      (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-new-line ()
  "Ensure beginning of line. Try to avoid redundant blank lines."
  (unless (= (current-column) 0)
    (insert "\n")))

(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'. INSERTS text into active buffer with properties.
XXX In processing subnodes, each case will prepend a space if it needs it."

  (when (and bm-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
    ;; For red-letter display.
    (setq iproperties (plist-put iproperties 'jesus t)))

  (dolist (subnode (dom-children node))
    (cond ((null subnode) nil)
	  ((stringp subnode)
	   (let* ((search-string (concat (car bm-current-book) " " (number-to-string bm-current-chapter) ":"))
		  (match (string-match search-string subnode)))
	     (when match
	       (setq subnode (string-replace search-string "" subnode))
	       (setq match (string-match "[0-9]+:" subnode))
	       ;; Verse number
	       (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple") nil subnode)))
	   ;; Red letter
	   (when (plist-get iproperties 'jesus)
	     (add-face-text-property 0 (length subnode) '(:foreground "red") nil subnode))
	   (insert subnode))
;;;;	  Maybe process these at some point? Include footnotes etc.
;;;	  ((eq (dom-tag subnode) 'node) nil)
;;;	  ((eq (dom-tag subnode) 'lb) nil)
	  ;; These tags appear in ESV modules (and maybe others?) XXX still not right
	  ((eq (dom-tag subnode) 'l)
	   (let ((attributes (dom-attributes subnode)))
	     (cond ((equal (cdr (assoc 'type attributes)) "x-br")
		    (bm-new-line))
		   ((equal (cdr (assoc 'type attributes)) "x-indent")
		    (insert "\t"))
		   ((assoc 'level attributes)
		    (let ((indent (string-to-number (cdr (assoc 'level attributes)))))
		      (when (= indent 2) (insert "\n\t")))))))
	  ((eq (dom-tag subnode) 'title)
	   (when (not notitle) (setq bm-chapter-title subnode) (bm-new-line)))
	  ((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) 'divinename) (bm-handle-divine-name subnode))
	  ;; This tag is used for red letter.
	  ((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))
	  ;; Some modules use this for line breaks and such.
	  ((and (eq (dom-tag subnode) 'milestone) (equal (cdr (assoc 'type (dom-attributes subnode))) "line"))
	   (bm-new-line))
	  ((or (eq (dom-tag subnode) 'transchange) 
	       (eq (dom-tag subnode) 'hi))  
	   ;; Word inserted by translation, not in original, give visual indication.
	   (let ((word (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"))))))))


(defvar bm-debugme nil)

(defun bm--display (&optional verse)
  "Render text for `bible-mode'. 
If VERSE is supplied, set cursor at verse."

  ;; 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.
    (unless bm-debugme
      (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))))

  ;; 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-current-book-name " " (number-to-string bm-current-chapter) ") "
			  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))))

  ;; Get rid of spurious spaces.
  (format-replace-strings '(("." . ". ")
			    ("," . ", ")
			    (";" . "; ")
			    (":" . ": ")
			    ("?" . "? ")
			    ("!" . "! ")
			    (" ." . ". ")
			    (" ," . ", ")
			    (" ;" . "; ")
			    (" :" . ": ")
			    (" ?" . "? ")
			    (" !" . "! ")
			    ("“ " . "“")
			    ("‘ " . "‘")
;;;			    (" ”" . "”")
;;;			    (" ’" . "’")
			    ("   " . " ")
			    ("  " . " ")
			    )
			  nil (point-min) (point-max))

  (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 ()
  "Return 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\r]+"))
	(when (equal line "Commentaries:")
          (throw 'done nil))
	(when (not (equal "Biblical Texts:" line))
          (push (split-string line " : ") modules))))
    modules))

(defun bm-pick-module ()
  "Keymap action function---select module user chooses."
  (interactive)
  (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 ()
  "Display available modules, allow user to select."
  (interactive)
  (let ((buf (get-buffer-create "Modules"))
	(mods (bm--list-biblical-modules)))
    (set-buffer buf)
    (module-select-mode)
    (setq buffer-read-only nil)
    (erase-buffer)
    (setq-local tab-stop-list '(25))
    (dolist (mod mods)
      (let ((name (string-trim (car mod)))
	    (description (string-trim-left (cadr mod))))
	(insert 
	 (propertize (string-trim name)
		     'face 'bold 
		     'module name
		     'help-echo (concat "Select " name)
		     'keymap bm-module-map))
	(move-to-tab-stop)
	(insert (format "%s\n" description))))
    (setq buffer-read-only t)
    (goto-char (point-min))
    (pop-to-buffer buf nil t)))


;;;;; Bible Searching

(defun bm--open-search (query searchmode mod)
  "Open a search buffer of QUERY using SEARCHMODE in module MOD."
  (let ((buf (get-buffer-create (concat "*bible-search-" (downcase mod) "-" query "*"))))
    (set-buffer buf)
    (bible-search-mode)
    (bm--display-search query searchmode mod)
    (pop-to-buffer buf nil t)))

(defun bm--display-search (query searchmode mod)
  "Render results of search QUERY from SEARCHMODE.
Module MOD is used for the query."
  (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 nil)
	 (query-verses "")
	 fullverses)
    (if (equal result (concat "none (" mod ")"))
	(insert "No results found."
		(if (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
	    (push
	     ;; Massage match to make it more sortable, get rid of
	     ;; some characters.
	     (replace-regexp-in-string 
	      "I " "1"
	      (replace-regexp-in-string
	       "II " "2"
	       (replace-regexp-in-string ".+; " "" matchstr)))
	     verses)))

	(setq match 0)
	(setq verses (sort verses))
	(dolist (verse verses)
	  (if query-verses
	      (setq query-verses (concat query-verses ";" verse))
	    (setq query-verses verse)))
	(setq fullverses (let ((bm-show-diatheke-exec nil)) (bm--exec-diatheke query-verses nil nil nil mod)))

	(insert fullverses)
	    
	(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 "(" mod ")") nil t)
	    (replace-match "")))))

    (setq mode-name (concat "Bible Search (" mod ")"))
    (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)

  (setq buffer-read-only nil)

  (goto-char (point-min))
  ;; This enables clicking on Strong's numbers in some lexicon definitions.
  (while (search-forward-regexp "[0-9]+" nil t)
    (cond ((eq termtype 'hebrew)
	   (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:H" (match-string 0)))
	   (put-text-property (match-beginning 0) (match-end 0) 'keymap bm-hebrew-keymap)
	   (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))
	  ((eq termtype 'greek)
	   (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:G" (match-string 0)))
	   (put-text-property (match-beginning 0) (match-end 0) 'keymap bm-greek-keymap)
	   (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))))

  (goto-char (point-min))

  ;; This enables clicking on verse references.
  (while (search-forward-regexp bm-verse-regexp nil t)
    (put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
    (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
    (put-text-property (match-beginning 0) (match-end 0) 'help-echo (concat "Go to " (match-string 0)))
    (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue")))
  (goto-char (point-min))

  (while (search-forward "()" nil t)
    (replace-match ""))
  (goto-char (point-min))
  (setq buffer-read-only t))


(defun bm--open-term-hebrew (term)
  "Open 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)
  "Open a buffer of the Strong's Greek TERM 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. 
Sets 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--lookup-lex-greek term)))
  (bm--display-term 'greek))


(defun bm--set-location (book chapter &optional verse)
  "Set the BOOK, CHAPTER and optionally VERSE 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.
If PREFIX is supplied, prepend PREFIX to the entries.
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: