bible/bible.el

;;; -*- mode: EMACS-LISP; lexical-binding: t -*-

;;
;; bible.el --- A browsing interface for the SWORD Project's Diatheke CLI
;;
;; Copyright (c) 2025 Fred Gilham

;; Author: Fred Gilham
;; URL: https://gitbot.homedns.org/fred/bible-mode
;; Version: 1.0.0
;; Keywords: files, text, hypermedia
;; Package-Requires: ((emacs "29.1"))

;;; Commentary:

;; Forked and extensively modified from package by Zacalot
;; Url: https://github.com/Zacalot/bible-mode

;; This package uses the `diatheke' program to browse and search
;; Biblical texts provided by the Sword project.
;; Word study is also supported.

;;; Usage:

;; Use M-x `bible-open' to open a Bible buffer.
;; Use C-h f `bible' to see available keybindings.
;; The program also installs a Bible menu with keybindings and other
;; commands.

;; You may customize `bible-module' to set a default browsing
;; module, as well as `bible-word-study-enabled' to enable word
;; study by default.

;;; Design:

;; The idea here is to use the diatheke program to insert text 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--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.

;;; Code:

;; Turn off tool bar mode because we are greedy for pixels....
(tool-bar-mode -1)
;; eldoc isn't meaningful in this program, and this saves space in the
;; mode line.
(global-eldoc-mode -1)

;;;; Requirements

(require 'cl-lib) ; Just used for cl-search in two places.
(require 'dom)
(require 'shr)

  
;;; dom-text and dom-texts declared obsolescent in emacs 31. check for
;;; new function, retain backward compatibility.
(defalias 'bible-dom-text
  (if (fboundp 'dom-inner-text)
      (lambda (node)
	(dom-inner-text node))
    (with-no-warnings
      (lambda (node)
	(dom-text node)))))

(defalias 'bible-dom-texts
  (if (fboundp 'dom-inner-text)
      (lambda (node)
	(dom-inner-text node))
    (with-no-warnings
      (lambda (node)
	(dom-texts node)))))


;;;; Variables

(defgroup bible nil
  "Settings for `bible'."
  :group 'tools
  :link '(url-link "https://gitbot.homedns.org/fred/bible-mode"))

(defcustom bible-module
  "KJV"
  "Default book module for Diatheke to query. (For full list of installed
modules, run `diatheke -b system -l bibliography')"
  :type '(choice (const :tag "None" nil)
                 (string :tag "Module abbreviation (e.g. \"KJV\")"))
;;  :local t
  :group 'bible)

;;;
;;; XXX Not implememted yet
(defcustom bible-font
  "Ezra SIL"
  "Default font for bible (not yet implemented)."
  :type '(string :tag "Font family name (e.g. \"Ezra SIL\")")
  :local t
  :group 'bible)

(defcustom bible-sword-query
  "diatheke"
  "Program used to query sword modules---some version of the sword
library's diatheke program."
  :type '(string :tag "Sword library query executable (e.g. \"/usr/local/bin/diatheke\").")
  :local nil
  :group 'bible)


(defcustom bible-greek-lexicon
  ;; AbbottSmithStrongs now has both links to lemmas and definitions
  ;; keyed by lemma. So we only need the AbbottSmithStrongs lexicon
  ;; and not the AbbottSmith 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)


(defcustom bible-use-index-for-lexicon t
  "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. XXX AbbottSmithStrongs now has both links and complete
entries instead of just links."
  :type 'boolean
  :local nil
  :group 'bible)

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


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


;;; XXX The Hebrew lexicons differ on whether they accept keys of the
;;; form `Hnnnn' or `nnnn'. The code does not yet handle this
;;; correctly, so stick with the following.
(defcustom bible-hebrew-lexicon
  "BDBGlosses_Strongs" ; This seems to work
  "Lexicon used for displaying definitions of Hebrew words using Strong's
codes. Note that changing this may require changing some code. See
bible--display-lemma-hebrew."
  :type '(string :tag "Lexicon module (e.g. \"BDBGlosses_Strongs\")")
  :local nil
  :group 'bible)

(defcustom bible-hebrew-lexicon-short
  "StrongsRealHebrew"
  "Lexicon used for displaying definitions of Hebrew words in tooltips."
  :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
  :local nil
  :group 'bible)


(defcustom bible-word-study-enabled
  nil
  "Display original language Lemma words if present in module 
(e.g. in KJV New Testament)."
  :type 'boolean
  :local t
  :group 'bible)

(defcustom bible-red-letter-enabled
  t
  "Display words of Jesus in red when module has that information."
  :type 'boolean
  :local t
  :group 'bible)

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

;;; variable defs

(defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")

(defvar bible--modules (lazy-completion-table bible--modules bible--list-biblical-modules))

;; XXX I believe these chapter counts aren't the same for all modules, e.g. JPS.
(defvar bible--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)
    ("1 Samuel"		. 31)	("2 Samuel"		. 24)	("1 Kings"		. 22)	("2 Kings"		. 25)
    ("I Chronicles"	. 29)	("II Chronicles"	. 36)	("Ezra"			. 10)	("Nehemiah"		. 13)
    ("1 Chronicles"	. 29)	("2 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)
    ("1 Corinthians"	. 16)	("2 Corinthians" 	. 13)
    ("Galatians"	. 6)	("Ephesians"		. 6)	("Philippians"		. 4)	("Colossians"		. 4)
    ("I Thessalonians"	. 5)    ("II Thessalonians"	. 3)    ("I Timothy"		. 6)    ("II Timothy"		. 4)
    ("1 Thessalonians"	. 5)    ("2 Thessalonians"	. 3)    ("1 Timothy"		. 6)    ("2 Timothy"		. 4)
    ("Titus"		. 3)	("Philemon"		. 1)	("Hebrews"		. 13)	("James"		. 5)
    ("I Peter"		. 5)    ("II Peter"		. 3)    ("I John"		. 5)    ("II John"		. 1)
    ("1 Peter"		. 5)    ("2 Peter"		. 3)    ("1 John"		. 5)    ("2 John"		. 1)
    ("III John"		. 1)    ("Jude"			. 1)	("Revelation of John"	. 22)
    ("3 John"		. 1))
  "A-list of name / chapter count for Bible books.")


;; XXX Add abbreviations found in other documents/commentaries?
(defvar bible--book-name-abbreviations
  '(;; Old Testament
    ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
    ("De"     . "Deuteronomy")     ("Js"    . "Joshua")           ("Jg"   . "Judges")	     ("Judg"   . "Judges")
    ("Ru"    . "Ruth")		   ("1 Samuel"     . "I Samuel")  ("I Sa"  . "I Samuel")     ("1 Sa" . "I Samuel")
    ("2 Samuel"     . "II Samuel") ("II Sa" . "II Samuel")	  ("2 Sa" . "II Samuel")     ("1 Kings"  . "I Kings")
    ("I Ki"  . "I Kings")	   ("1 Ki" . "I Kings")		  ("2 Kings"      . "II Kings") ("II Ki" . "II Kings")
    ("2 Ki" . "II Kings")          ("1 Chronicles" . "I Chronicles")  ("I Ch"  . "I Chronicles")  ("1 Ch" . "I Chronicles")
    ("2 Chronicles" . "II Chronicles") ("II Ch" . "II Chronicles") ("2 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
    ;; Added AbbottSmith lexicon abbreviations to allow proper following of cross references in lexicon buffers.
    ("Mt" . "Matthew") ("Matt" . "Matthew")
    ("Mk" . "Mark") ("Lk" . "Luke") ("Jo" . "John") ("Ac" . "Acts")
    ("Ro" . "Romans") ("Rom" . "Romans")
    ("1 Corintihans" . "I Corinthians") ("I Co" . "I Corinthians") ("1 Co" . "I Corinthians") ("ICor" . "I Corinthians")
    ("2 Corinthians" . "II Corinthians") ("II Co" . "II Corinthians") ("2 Co" . "II Corinthians") ("IICor" . "II Corinthians")
    ("Ga" . "Galatians") ("Gal" . "Galatians")
    ("Eph" . "Ephesians")
    ("Phl" . "Philippians") ("Phil" . "Philippians")
    ("Col" . "Colossians")
    ("1 Thessalonians" . "I Thessalonians")  ("I Th" . "I Thessalonians") ("1 Th" . "I Thessalonians") ("IThess" . "I Thessalonians")
    ("2 Thessalonians" . "II Thessalonians") ("II Th" . "II Thessalonians") ("2 Th" . "II Thessalonians") ("IIThess" . "II Thessalonians")
    ("1 Timothy" . "I Timothy")   ("I Ti"  . "I Timothy")  ("1 Ti" . "I Timothy")  ("ITim" . "I Timothy")
    ("2 Timothy" . "II Timothy")  ("II Ti" . "II Timothy") ("2 Ti" . "II Timothy") ("IITim" . "II Timothy")
    ("Tit" . "Titus")
    ("Phm" . "Philemon") ("Phlm" . "Philemon")
    ("He"   . "Hebrews") ("Heb"   . "Hebrews")
    ("Ja"    . "James") ("Jas"    . "James")
    ("1 Peter" . "I Peter")   ("I Pe"   . "I Peter")  ("1 Pe" . "I Peter")
    ("2 Peter" . "II Peter")  ("II Pe"  . "II Peter") ("2 Pe" . "II Peter") ("IIPet" . "II Peter")
    ("1 John"  . "I John")    ("I Jo"   . "I John")   ("1 Jo" . "I John") ("IJohn" . "I John")
    ("2 John"  . "II John")   ("II Jo"  . "II John")  ("2 Jo" . "II John")   ("IIJohn" . "II John")
    ("3 John"  . "III John")  ("III Jo" . "III John") ("3 Jo" . "III John") ("IIIJohn" . "III John")
    ("Ju"    . "Jude")
    ("Re"   . "Revelation of John") ("Rev"   . "Revelation of John"))
  "A-list of abbreviations for Bible books.")

;;;; Book / chapter

(defvar-local bible--current-book (assoc "Genesis" bible--books)
  "Current book data (name . chapter).")

(defvar-local bible--current-book-name "Genesis"
  "Current book name.")

(defvar-local bible--current-chapter 1
  "Current book chapter number.")

(defvar-local bible-query nil
  "Search query associated with the buffer.")

(defvar-local bible-search-mode "phrase"
  "Search mode: either `lucene', `phrase', `regex' or `multiword'.")

(defvar bible-search-range nil)

(defvar-local bible-has-lexemes nil
  "Set if the module being displayed has lexical entries availabile.")

(defvar-local bible-has-morphemes nil
  "Set if the module being displayed has morphemes availabile.")

;;;; Keymaps

;;;; N.B. Bible menu items appear in reverse order of their
;;;; definition below

(defconst bible-map (make-sparse-keymap)
  "Keymap for bible.")
(define-key bible-map [menu-bar bible]
	    (cons "Bible" (make-sparse-keymap "Bible")))

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

(defun bible-toggle-display-diatheke ()
  "Toggle diatheke args display."
  (interactive)
  (setq bible-show-diatheke-exec (not bible-show-diatheke-exec))
  (message ""))

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

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

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

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

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

;;;;; Misc
(define-key bible-map "m" 'bible-select-module)
(define-key bible-map "w" 'bible-toggle-word-study)
(define-key bible-map "l" 'bible-toggle-red-letter)

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

;;;;; Search
(define-key bible-map "/" 'bible-search)
(define-key bible-map "s" 'bible-search)
(define-key bible-map
	    [menu-bar bible search]
	    '("Search" . bible-search))

(define-key bible-map "r" 'bible-set-search-range)
(define-key bible-map
	    [menu-bar bible range]
	    '("Set Search Range" . bible-set-search-range))

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

(define-key bible-map "n" 'bible-next-chapter)
(define-key bible-map
	    [menu-bar bible next-chapter]
	    '("Next Chapter" . bible-next-chapter))

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

;;;;; Direct jump
(define-key bible-map "c" 'bible-select-chapter)
(define-key bible-map
	    [menu-bar bible select-chapter]
	    '("Select Chapter" . bible-select-chapter))

(define-key bible-map "b" 'bible-select-book)
(define-key bible-map
	    [menu-bar bible select-book]
	    '("Select Book" . bible-select-book))


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


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

(defun bible-next-search-item ()
  "Go to next item in list of found verses."
  (interactive)
  (search-forward-regexp bible--verse-regexp))

(defun bible-previous-search-item ()
  "Go to previous item in list of found verses."
  (interactive)
  (search-backward-regexp bible--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" 'bible-toggle-word-study)
(define-key bible-search-mode-map "n" 'bible-next-search-item)
(define-key bible-search-mode-map "p" 'bible-previous-search-item)
(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)

(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 bible-text-direction 'left-to-right)

(defun bible-toggle-text-direction ()
  "Switch between left-to-right and right-to-left text direction."
  (interactive)
  (if (eq bible-text-direction 'left-to-right)
      (setq-local bible-text-direction 'right-to-left)
    (setq-local bible-text-direction 'left-to-right))
  (setq-local bidi-paragraph-direction bible-text-direction))


(defvar-local bible-search-query nil
  "Query used in toggles (word study and red letter).")

(defvar bible-use-tooltips t)
(setq tooltip-delay 1)
(setq tooltip-short-delay .5)
(setq use-system-tooltips nil)

;;(setq tooltip-mode -1)
;;(setq tooltip-resize-echo-area t)


(defun bible-toggle-tooltips ()
  "Toggle use of tooltips to display lexical/morphological items."
  (interactive)
  (setq bible-use-tooltips (not bible-use-tooltips))
  (tooltip-mode 'toggle)
  (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 ""))


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

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

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

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

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


(defun bible--display-greek ()
  "Display Greek text.
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 bible-greek-keymap (make-sparse-keymap))
(define-key bible-greek-keymap (kbd "RET") 'bible--display-greek)
(define-key bible-greek-keymap [mouse-1] 'bible--display-greek)

(defun bible--display-hebrew ()
  "Display Hebrew text.
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 bible-hebrew-keymap (make-sparse-keymap))
(define-key bible-hebrew-keymap (kbd "RET") 'bible--display-hebrew)
(define-key bible-hebrew-keymap [mouse-1] 'bible--display-hebrew)

(defconst bible-lemma-keymap (make-sparse-keymap))
(define-key bible-lemma-keymap (kbd "RET")
	    (lambda ()
	      (interactive)))

;; Not used. Not really sure what to do here or if it's useful to do anything.
(defconst bible-morph-keymap (make-sparse-keymap))
(define-key bible-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 special-mode "Bible"
  "Mode for reading the Bible.
\\{bible-map}"
  (buffer-disable-undo)
  (font-lock-mode t)
  (use-local-map bible-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 bible-module-select-mode special-mode "Select Text Module"
  (buffer-disable-undo)
  (font-lock-mode t)
  (setq buffer-read-only t))


;;;; Functions

;;;;; Commands

(defun bible-open (&optional book-name chapter verse)
  "Create and open a `bible' buffer with BOOK-NAME, CHAPTER and VERSE.
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)
  (with-current-buffer (get-buffer-create (generate-new-buffer-name (concat "*bible*")))
    (bible)
    (bible--set-location
     (or (assoc (or book-name "Genesis") bible--books) (list book-name))
     (or chapter 1)
     verse)
    (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))

(defun bible-next-chapter ()
  "Page to the next chapter for the active `bible' buffer."
  (interactive)
  (let* ((book-chapters (cdr bible--current-book))
	 (chapter (min book-chapters (+ bible--current-chapter 1))))
    (bible--set-location bible--current-book chapter)))

(defun bible-previous-chapter ()
  "Page to the previous chapter for the active `bible' buffer."
  (interactive)
  (bible--set-location bible--current-book (max 1 (- bible--current-chapter 1))))


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


(defun bible-select-book ()
  "Ask user for a new book and chapter for the current `bible' buffer."
  (interactive)
  (let* ((completion-ignore-case t)
	 (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"))))
    (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))))
      (?3 (setq book-data (cons (concat "III" (substring book-data-string 1)) (cdr book-data)))))
    (setq-local bible--current-book book-data)
    (setq-local bible--current-book-name (car book-data))
    (setq-local bible--current-chapter chapter)
    (bible--display)))


(defun bible-select-chapter ()
  "Ask user for a new chapter for the current `bible' buffer."
  (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"))))
    (when chapter
      (bible--set-location bible--current-book chapter))))

(defun bible-set-search-range ()
  "Ask user for a new text module for the current `bible' buffer."
  (interactive)
  (let ((range (read-string "Range (<return> to clear): ")))
    (if (string-equal range "")
	(setq bible-search-range nil)
      (setq bible-search-range range))))


(defun bible-select-module ()
  "Ask user for a new text module for the current `bible' buffer."
  (interactive)
  (setq-default bible-module (completing-read "Module: " bible--modules))
  (bible--display))

(defun bible-toggle-word-study ()
  "Toggle the inclusion of word study for the active `bible' buffer."
  (interactive)
  (setq bible-word-study-enabled (not bible-word-study-enabled))
  (bible--display))

(defun bible-toggle-red-letter ()
  "Toggle red letter mode for the active `bible' buffer."
  (interactive)
  (setq bible-red-letter-enabled (not bible-red-letter-enabled))
    (bible--display))

(defun bible-split-display ()
  "Copy the active `bible' buffer into a new buffer in another window."
  (interactive)
  (split-window-right)
  (balance-windows)
  (other-window 1)
  (bible-open bible--current-book-name bible--current-chapter))

(defun bible-search (query)
  "Search for a QUERY: a word or phrase.  
Asks the user for type of search: either `lucene', `phrase', `regex'
or `multiword'.  `lucene' is the default search.

`lucene' mode requires an index to be built using the `mkfastmod' program."
  (interactive "sBible Search: ")
  (when (> (length query) 0)
    (let* ((bible-module (buffer-local-value 'bible-module (current-buffer)))
	   (searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
      (bible--open-search query searchmode))))

(defun bible-search-mode-follow-verse ()
  "Follow the hovered verse in a `bible-search-mode' buffer.
Create a new `bible' buffer positioned at the selected verse."
  (interactive)
  (let* ((text (thing-at-point 'line t))
         book
         chapter
         verse)
    (string-match bible--verse-regexp text)
    (setq text (match-string 0 text))
    (message "Following verse result: %s" text)
    (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
    (setq book (match-string 0 text))
    (string-match "[0-9]?[0-9]?[0-9]?:" text)
    (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
    (string-match ":[0-9]?[0-9]?[0-9]?" text)
    (setq verse (substring (match-string 0 text) 1))
    (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))

(defun bible-search-mode-follow-xref ()
  "Follow the hovered verse in a bible term buffer.
Create a new `bible' buffer positioned at the specified verse.
XXX We use the current module to avoid opening cans of worms regarding
OT/NT etc. If that module doesn't have that verse...???
Handle abbreviations from lexicon module (AbbottSmith)."
  (interactive)
  (let* ((xref (get-text-property (point) 'xref))
	 (verse-ref (split-string xref))
	 book-abbrev
	 chapter-verse
	 book
	 chapter
	 verse)
    (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.
    (setq 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))))


;;; These can be called interactively if you know the Strong's number
;;; you want to look up.

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

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

;;; Interactively insert a verse into an arbitrary current buffer.
(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: " bible--books nil t) bible--books))
         (chapter (when book-data (completing-read "Chapter: " (bible--list-number-range 1 (cdr book-data)) nil t "1" nil "1")))
         (verse (when chapter (read-from-minibuffer "Verse: ")))
	 (query (concat (car book-data) " " chapter ":" verse))
	 (args (list bible-sword-query nil (current-buffer) t "-b" bible-module "-f" "plain" "-k" query)))
    (apply #'call-process args)))


;;;;; Support

(defconst bible-diatheke-filter-options " avlnmw")

;;;; XXX
;;;; Can we avoid returning (buffer-string) and just use whatever buffer is current?
;;;;
(defun bible--exec-diatheke (query &optional filter format module)
  "Execute `diatheke' with specified QUERY options, returning output
buffer. FILTER is the Diatheke filter argument. FORMAT is either plain
or the default of internal. MODULE is the text module to use."
  (let ((module (or module bible-module)))
    (with-temp-buffer
      (let ((args (list bible-sword-query nil (current-buffer) t "-b" module)))
	(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
	  (message "%s" args))
	(apply 'call-process args))
      (buffer-string))))


(defun bible--diatheke-search (query searchtype &optional format module)
  "Execute `diatheke' for searches. Requires the search query and the
search type. Optional argument FORMAT is either plain or the default of
internal. MODULE is the text module to use and defaults to the current
module."
  (with-temp-buffer
    (let ((args (list bible-sword-query nil (current-buffer) t "-b" (or module bible-module))))
      (setq args (append args (list "-s" (pcase searchtype
					   ("lucene" "lucene")
					   ("phrase" "phrase")
					   ("regex" "regex")
					   ("multiword" "multiword")))))
      (when bible-search-range (setq args (append args (list "-r" bible-search-range))))
      (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))
    (buffer-string)))


;;; XXX Bible chapter titles mostly appear in Psalms. This code works
;;; OK except for Psalm 119 which changes the chapter title to
;;; indicate the Hebrew letter that each verse of a stanza begins
;;; with.
;;;
;;; Chapter titles seem to be part of each verse in the modules I saw.
;;;
;;; Fixing this issue would require keeping track of the current
;;; chapter title and emitting the title whenever it changed. Since
;;; there is (AFAIK) only one chapter in the Bible that has this
;;; issue, it doesn't seem like a high priority now.
(defvar-local bible-chapter-title nil
  "Text preceding start of chapter.
Mostly in Psalms, like `Of David' or the like.")

;;;
;;; Greek and Hebrew lexeme and morpheme tooltip rendering.
;;;

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

;;; Hash tables for tooltips.
(defvar lex-hash (make-hash-table :test 'equal :size 10000))
(defvar morph-hash (make-hash-table :test 'equal :size 10000))

;;; Use HTMLHREF format with diatheke, post-process to render html.
(defun bible--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 bible-sword-query nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
      (when bible-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 bible--lex-query (query module)
  "Execute `diatheke' for QUERY, using MODULE. 
Plain format, returns string."
  (bible--exec-diatheke query nil "plain" module))


(defun bible--lookup-lemma-index (key)
  "Return the Greek lemma from lemma index with a strong's number as KEY."
  (string-trim
   (string-replace
    (concat "(" bible-lexicon-index) 
    ""
    (bible--lex-query key bible-lexicon-index))))

;;;
;;; 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 bible--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 bible--lookup-def-greek (key)
  "Execute `diatheke' to do query on KEY.
Massage output so verse cross references are usable.  Returns string."
  (with-temp-buffer
    (let ((args (list bible-sword-query nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "plain" "-k" key)))      
      (when bible-show-diatheke-exec
	(message "%s" args))
      (apply 'call-process args)
      (bible--cleanup-lex-text (string-replace (concat "(" bible-greek-lexicon ) "" (buffer-string))))))

(defun bible--lookup-lemma-greek-indexed (key)
  "Lookup 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 (bible--lookup-lemma-index key))) ; Get lemma from Strong's number
    (when lemma-entry
      (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.
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 bible-hash-greek)
      (puthash key
	       (if bible-use-index-for-lexicon
		   (bible--lookup-lemma-greek-indexed key)
		 (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."
  (with-temp-buffer
    (let ((args (list bible-sword-query nil (current-buffer) t "-b" bible-hebrew-lexicon "-f" "plain" "-k" key)))
      (when bible-show-diatheke-exec
	(message "%s" args))
      (apply 'call-process args)
      (bible--process-href)
      (bidi-string-mark-left-to-right
       (string-replace (concat "(" bible-hebrew-lexicon ) "" (substring (buffer-string) 7))))))

(defun bible--lookup-lemma-hebrew (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 bible-hash-hebrew)
      (puthash key
	       (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.
;;;
(defun bible--lookup-lemma-greek-short (lemma)
  "Look up Greek lexical entry for LEX from short Greek lexicon."
  (when (string-match "[0-9]+" lemma)
    (bible--lex-query (match-string 0 lemma) bible-greek-lexicon-short)))

(defun bible--lookup-lemma-hebrew-short (lemma)
  "Look up Hebrew lexical entry for LEX from short Hebrew 
lexicon (StrongsRealHebrew)."
  (when (string-match "[0-9]+" lemma)
    ;; Remove redundant stuff at the beginnning.
    (substring (bible--lex-query (concat (match-string 0 lemma)) bible-hebrew-lexicon-short) 7)))

(defun bible--lookup-lex (lex)
  "Look up lexical item LEX. This is used for tooltips.
Return hash table entry if present in lex-hash cache, else look up in
database and stash in cache."
  (when lex
    (let* ((key (substring lex 7)) ; strip off "strong:" prefix.
	   (lex-text (gethash key lex-hash)))
      ;; XXX Kludge alert! Emacs tooltips look really nice for Greek
      ;; terms, but Hebrew needs system tooltips because of direction
      ;; issues.
      (setq use-system-tooltips (if (string-prefix-p "G" key) nil t))
      (if lex-text
	  lex-text
      	(setq lex-text
	      (cond ((string-prefix-p "G" key)
		     (string-replace 
		      (concat "(" bible-greek-lexicon-short ) 
		      ""
		      (bible--lookup-lemma-greek-short key)))
		    ((string-prefix-p "H" key)
		     (bidi-string-mark-left-to-right
		      (string-replace
		       (concat "(" bible-hebrew-lexicon-short)
		       ""
		       (bible--lookup-lemma-hebrew-short key))))))
	(puthash key (string-fill (bible--cleanup-lex-text lex-text) 75) lex-hash)))))

(defun bible--lookup-morph-entry (morph)
  "Look up entry for morphological item MORPH. 
Return hash table entry if present in morph-hash cache, else look up in
database and stash in cache."
  (when morph
    (or (gethash morph morph-hash)
	(puthash morph
		 (let (morph-module morph-key)
		   (cond ((string-prefix-p "robinson:" morph)
			  (setq morph-module "Robinson")
			  (setq morph-key (substring morph (length "robinson:"))))
			 ((string-prefix-p "packard:" morph)
			  (setq morph-module "Packard")
			  (setq morph-key (substring morph (length "packard:"))))
			 ((string-prefix-p "oshm:" morph)
			  (setq morph-module "OSHM")
			  (setq morph-key (substring morph (length "oshm:")))))
		   (string-replace (concat "(" morph-module )
				   ""
				   (bible--morph-query morph-key morph-module)))
		 morph-hash))))


(defvar bible-outline-strings
  '(;;(". ."	.	".")
    (" I. ."	.	"\nI.")
    (" II. ."	.	" II.")
    (" III. ."	.	" III.")
    (" IV. ."	.	" IV.")
    (" V. ."	.	" V.")
    ("1. ."	.	"\n 1.")
    ("2. ."	.	"2.")
    ("3. ."	.	"3.")
    ("4. ."	.	"4.")
    ("5. ."	.	"5.")
    ("6. ."	.	"6.")
    ("7. ."	.	"7.")
    ("8. ."	.	"8.")
    ("9. ."	.	"9.")
    ("a. ."	.	"\n    a.")
    ("(a)."	.	"\n    (a).")
    ("b. ."	.	"    b.")
    ("c. ."	.	"    c.")
    ("d. ."	.	"    d.")
    ("e. ."	.	"    e.")
    ("f. ."	.	"    f.")
    ("g. ."	.	"    g.")
    ("h. ."	.	"    h.")
    (" . "	.	". ")
    ("\n\n"	.	"\n")))

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


;;;
;;; Get string for tooltip display
;;;
(defun bible--show-lex-morph (_window object pos)
  "Get text for tooltip display for OBJECT at POS in WINDOW.
Includes both lex and morph definitions if text module has
both tags, otherwise just get lex definition."
  (let* ((lex (get-text-property pos 'strong object))
	 (lex-text (bible--lookup-lex lex))
	 (morph (get-text-property pos 'morph object))
	 (morph-text (bible--lookup-morph-entry morph)))
    (when lex-text
      ;; This removes backslashes to prevent bogus command
      ;; substitutions (that is, emacs mistakenly filling in a key
      ;; binding for some command---see Info doc on Substituting Key
      ;; Bindings) in the tooltip. XXX I couldn't figure out a better
      ;; way to bypass command substitution in the tooltips.
      (subst-char-in-string 
       ?\\ 
       ?
       (if morph-text
	   (concat (string-trim lex-text) "\n" (string-trim morph-text))
	 (string-trim lex-text))))))



(defun bible-handle-divine-name (item)
  "When ITEM is divine name, display it as such."
  (insert "LORD")
  (let* ((refstart (- (point) (length "LORD")))
	 (refend (point))
	 (strongs (dom-attr item 'savlm)))
    (add-face-text-property refstart refend 'bold)
    (put-text-property refstart refend 'keymap bible-hebrew-keymap)
    (when (and strongs (string-match "strong:H" strongs))
      (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
      (put-text-property refstart refend 'strong (match-string 0 strongs)))))


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

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

      (insert word)

      ;; 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 " ")
	(bible-handle-divine-name item))

      ;; lexical definitions
      (when (or lemma savlm)
	(let* ((matched nil)
	       (lexemes (split-string (or lemma savlm)))
	       ;; XXX Kludge alert. KJV module conflates articles with lemmas. Deal with this.
	       (lexeme (if (> (length lexemes) 2) (nth 1 lexemes) (nth 0 lexemes))))
	  (cond ((string-match "strong:G.*" lexeme) ; Greek
		 (setq matched (match-string 0 lexeme))
		 (put-text-property refstart refend 'keymap bible-greek-keymap))
		((string-match "strong:H.*" lexeme) ; Hebrew
		 (setq matched (match-string 0 lexeme))
		 (put-text-property refstart refend 'keymap bible-hebrew-keymap)))
	  ;; Add help-echo, strongs reference for tooltips if match.
	  (when matched
	    (setq bible-has-lexemes t)
	    (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
	    (put-text-property refstart refend 'strong matched))))

      ;; morphology
      (when morph
	(let* ((matched nil)
	       (morphemes (split-string morph))
       (morpheme (car (last morphemes)))) ; KJV kludge as above
	  (if (or
	       (string-match "robinson:.*" morpheme)	; Robinson Greek morphology
	       (string-match "packard:.*" morpheme)	; Packard Greek morphology --- LXX seems to use this
	       (string-match "oshm:.*" morpheme))	; OSHM Hebrew morphology
	      (setq matched (match-string 0 morpheme))
	    ;;(message "Unknown morphology %s" morph)
	    )
	  (when matched
	    (setq bible-has-morphemes t)
	    (put-text-property refstart refend 'morph matched)
	    (put-text-property refstart refend 'help-echo 'bible--show-lex-morph))))

      ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
      ;; XXX Should I enable lexicon lookups on these lemmas? I don't use
      ;; this anyway....
      (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))
	  (insert " " word)
	  (let ((refstart (- (point) 1 (length word)))
		(refend (point)))
	    (add-face-text-property refstart refend '(:foreground "blue"))
	    (put-text-property refstart refend 'keymap bible-lemma-keymap)))))))


(defun bible-new-line ()
  "Ensure beginning of line.  Try to avoid redundant blank lines."
  (unless (= (current-column) 0)
    (insert "\n")))

(defun bible--insert-domnode-recursive (node &optional iproperties notitle)
  "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
Inserts resulting text into active buffer with properties specified in
IPROPERTIES.  If NOTITLE is true, don't render title headings.
XXX In processing subnodes, each case will prepend a space if it needs it."

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

  (dolist (subnode (dom-children node))
    (cond ((null subnode) nil)
	  ((stringp subnode)
	   ;; Red letter
	   (when (plist-get iproperties 'jesus)
	     (add-face-text-property 0 (length subnode) '(:foreground "red") nil subnode))
	   (insert subnode))
	  ((consp subnode)
	   (let ((tag (dom-tag subnode)))
	     (pcase tag
	       ;; Maybe process these at some point? Include footnotes etc.
	       ;; ('node nil)
	       ;; ('lb nil)
	       ;; 'w is usual case.
	       ('w (insert " ") (bible--process-word subnode iproperties))
	       ;; Font tag should be ignored, treat as if 'w
	       ('font (insert " ") (bible--process-word subnode iproperties))
	       ('hi (when (equal (dom-attr subnode 'type) "bold")
		      (let ((word (bible-dom-text subnode)))
			(insert " " word)
			(put-text-property (- (point) (length word)) (point) 'face 'bold))))
	       ('i ; Italic face (special case for certain module)
		(let ((word (bible-dom-text subnode)))
		  (insert " " word)
		  (put-text-property (- (point) (length word)) (point) 'face 'bold)
		  (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
	       ;; '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 notitle))
	       ('title (when (not notitle) (setq bible-chapter-title subnode) (bible-new-line)))
	       ;; These tags appear in ESV modules (and maybe others?) XXX still not right
	       ('l
		(let ((attributes (dom-attributes subnode)))
		  (cond ((equal (dom-attr subnode 'type) "x-br")
			 (bible-new-line))
			((equal (dom-attr subnode 'type) "x-indent")
			 (insert "\t"))
			((dom-attr subnode 'level)
;;			 (bible-new-line)
			 (let ((indent (string-to-number (alist-get 'level attributes))))
			   (cond ((= indent 1) (insert "\t"))
				 ((= indent 2) (insert "\n\t\t"))))))))
	       ('divinename (bible-handle-divine-name subnode))
	       ;; Some modules use this for line breaks and such.
	       ('milestone (when (equal (dom-attr subnode 'type) "line") (bible-new-line)))
	       ('br (bible-new-line))
	       ('div (when (equal (dom-attr subnode 'type) "paragraph") (bible-new-line)))
	       ;; For commentaries and the like. XXX Clicking on verse doesn't work yet. This will take work.
	       ((or 'scripref 'reference) 
		(let ((word (bible-dom-text subnode)))
		  (let ((start (point)))
		    (insert " " word)
		    (let ((end (point)))
		      (put-text-property start end 'xref word)
		      (put-text-property start end 'keymap bible-search-mode-map)
		      (put-text-property start end 'help-echo (concat "Go to " word " (doesn't work yet)"))
		      (add-face-text-property start end '(:foreground "blue"))))))
	       ;; Various text properties---ignore for now
	       ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties notitle))
	       ;; Word inserted by translation, not in original, give visual indication.
	       ('transchange
		(let ((word (bible-dom-text subnode)))
		  (insert " " word)
		  (if (plist-get iproperties 'jesus)
		      (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
		    (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))


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

  (setq-local bible-module (default-value 'bible-module))

  (let ((buffer-read-only nil)
	(bible-chapter-title nil)
	(bible-has-lexemes nil)
	(bible-has-morphemes nil))
    (erase-buffer)
    (insert (bible--exec-diatheke (concat bible--current-book-name ":" (number-to-string bible--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 bible-debugme ; If this is true, display the XML.
	(erase-buffer)
	;; Looking for the "body" tag in the DOM node.
	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
	(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 (search-forward search-string nil t)
	  (replace-match "")
	  ;; Highlight verse number
	  (when (re-search-forward "^ *[0-9]+" nil t 1)
	    (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))

    (save-excursion
      ;; Remove the module name from the buffer.
      (while (re-search-forward (concat "^.*" bible-module ".*$") nil t)
	(replace-match "" nil t)))

    (save-excursion
       ;; Deal with chapter titles (i.e. in Psalms)
      ;; XXX 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 bible-chapter-title ; This gets set in bible-insert-domnode-recursive.
	(let ((title-text (bible-dom-texts bible-chapter-title))
	      (refstart (point-min))
	      refend)
	  (when (stringp title-text)
	    ;; Clear out XML stuff.
	    (setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
	    (insert title-text "\n")
	    (setq refend (point))
	    (put-text-property refstart refend 'face 'bold))))

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

    ;; Get rid of multiple consecutive spaces.
    (save-excursion
      (while (re-search-forward "  *" nil t) ; More than one space in a row
	(replace-match " ")))

    ;; Set the mode line of the biffer.
    (setq mode-name (concat "Bible (" bible--current-book-name " " (number-to-string bible--current-chapter) ") "
			    bible-module
			    (when bible-has-lexemes " Lex")
			    (when bible-has-morphemes " Morph")
			    ")")))

  ;; If optional verse specification go to that verse.
  (when verse
    (re-search-forward (concat " ?" (number-to-string verse)) nil t)))


(defun bible--list-biblical-modules ()
  "Return a list of accessible Biblical Text modules."
  (let ((text (bible--exec-diatheke "modulelist" 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))))
    (reverse modules)))

(defun bible-pick-module ()
  "Keymap action function---select module user chooses."
  (interactive)
  (let ((item (get-text-property (point) 'module)))
     (setq-default bible-module item)
    (bible-open)))


(defconst bible-module-map (make-keymap))
(define-key bible-module-map [mouse-1] 'bible-pick-module)
(define-key bible-module-map (kbd "RET") 'bible-pick-module)


(defun bible-display-available-modules ()
  "Display available modules, allow user to select."
  (interactive)
  (with-current-buffer (get-buffer-create "Modules")
    (bible-module-select-mode)
    (let ((buffer-read-only nil))
      (erase-buffer)
      (setq-local tab-stop-list '(25))
      (dolist (mod (bible--list-biblical-modules))
	(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 bible-module-map))
	  (move-to-tab-stop)
	  (insert (format "%s\n" description)))))
    (goto-char (point-min))
    (pop-to-buffer (current-buffer) nil t)))


;;;;; Bible Searching

(defun bible--open-search (query searchmode)
  "Open a search buffer of QUERY using SEARCHMODE in module MOD."
  (let ((results (string-trim (replace-regexp-in-string
			       "Entries .+?--" ""
			       (bible--diatheke-search query searchmode "plain" bible-module)))))
    (if (equal results (concat "none (" bible-module ")"))
	(message (concat 
		  "No results found."
		  (when (equal searchmode "lucene")
		    " Verify index has been build with mkfastmod.")))
	 
      (with-current-buffer (get-buffer-create (concat "*bible-search-" (downcase bible-module) "-" query "*"))
	(bible-search-mode)
	(bible--display-search results)
	(pop-to-buffer (current-buffer) nil t)))))

(defun bible--display-search (results)
  "Render RESULTS of search query."
  (let ((match 0)
	(matchstr "")
	(verses nil)
	(query-verses "")
	(buffer-read-only nil))
    (erase-buffer)
    (while match
      (setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
	    matchstr (match-string 0 results))

      (when match
	(push
	 ;; Massage match to make it more sortable, get rid of some characters.
	 (replace-regexp-in-string
	  ".+; " "" 
	  (string-replace
	   "I " "1"
	   (string-replace
	    "II " "2"
	    (string-replace
	     "III " "3"
	     matchstr))))
	 verses)))

    (sort verses #'string-version-lessp)
    (dolist (verse verses)
      (if query-verses
	  (setq query-verses (concat query-verses ";" verse))
	(setq query-verses verse)))
    (let ((bible-show-diatheke-exec nil))
	(insert (bible--exec-diatheke query-verses nil nil bible-module)))
    (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
      (erase-buffer)
      (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil))
    (goto-char (point-min))
    (save-excursion
      (while (re-search-forward (concat "^.*" bible-module) nil t)
	(replace-match ""))))
  (setq mode-name (concat "Bible Search (" bible-module))
  (when bible-search-range
    (setq mode-name (concat mode-name " [" bible-search-range "]")))
  (setq mode-name (concat mode-name ")")))

;;;;; Terms (lemmas, morphemes)


;;(defun bible-display-morphology (morph)
;; ;; xxx Do something here?
;;  )

(defun bible--fixup-lexicon-display (termtype)
  "Fixup the display of a lexical entry whose language is given by TERMTYPE."
  (let ((buffer-read-only nil))
    (goto-char (point-min))
    (save-excursion
      ;; This enables clicking on Strong's numbers in some lexicon definitions.
      (while (search-forward-regexp "[0-9]+" nil t)
	(let ((match (match-string 0))
	      (start (match-beginning 0))
	      (end (match-end 0)))
	  (cond ((eq termtype 'hebrew)
		 (put-text-property start end 'strong (concat "strong:H" match))
		 (put-text-property start end 'keymap bible-hebrew-keymap)
		 (add-face-text-property start end `(:foreground "blue")))
		((eq termtype 'greek)
		 (put-text-property start end 'strong (concat "strong:G" match))
		 (put-text-property start end 'keymap bible-greek-keymap)
		 (add-face-text-property start end `(:foreground "blue")))))))

    ;; This enables clicking on verse references.
    (save-excursion
      (while (search-forward-regexp bible--verse-regexp nil t)
	(let ((match (match-string 0))
	      (start (match-beginning 0))
	      (end (match-end 0)))
	  (put-text-property start end 'xref match)
	  (put-text-property start end 'keymap bible-search-mode-map)
	  (put-text-property start end 'help-echo (concat "Go to " (substring-no-properties match)))
	  (add-face-text-property start end '(:foreground "blue")))))

    (save-excursion
      (while (search-forward "()" nil t)
	(replace-match "")))))


(defun bible--open-term-hebrew (term)
  "Open a buffer of the Strong's Hebrew TERM's definition."
  (with-current-buffer (get-buffer-create (concat "*bible-term-hebrew-" term "*"))
    (bible-term-hebrew-mode)
    (setq-local bidi-paragraph-direction 'left-to-right)
    (bible--display-lemma-hebrew term)
    (pop-to-buffer (current-buffer) nil t)
    (fit-window-to-buffer)))


(defun bible--display-lemma-hebrew (lemma)
  "Render the definition of the Strong's Hebrew LEMMA.
This code is customized for the BDBGlosses_Strongs lexicon."
  (let ((buffer-read-only nil))
    (erase-buffer)
    ;; BDBGlosses_Strongs needs the prefixed `H'.
    (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew (concat "H" lemma))) 7))
;;    (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew lemma)) 7))
    (bible--fixup-lexicon-display 'hebrew)))


(defun bible--open-term-greek (term)
  "Open a buffer of the Strong's Greek TERM definition."
  (with-current-buffer (get-buffer-create (concat "*bible-term-greek-" term "*"))
    (bible-term-greek-mode)
    (bible--display-lemma-greek term)
    (pop-to-buffer (current-buffer) nil t)
    (fit-window-to-buffer)))

(defun bible--display-lemma-greek (lemma)
  "Render the definition of the Strong's Greek LEMMA."
  (let ((buffer-read-only nil))
    (erase-buffer)
    (insert (bible--lookup-lemma-greek lemma))
    (bible--fixup-lexicon-display 'greek)))


(defun bible--set-location (book chapter &optional verse)
  "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
  (setq-local bible-module (default-value 'bible-module))
  (setq-local bible--current-book book)
  (setq-local bible--current-book-name (car book))
  (setq-local bible--current-chapter chapter)
  (bible--display verse))

;;;;; Utilities

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

;;; bible.el ends here.


;; Local Variables:
;; End: