bible.el 73 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813
  1. ;;; bible.el --- A Bible browsing application -*- lexical-binding: t; mode: EMACS-LISP; -*-
  2. ;; Copyright (c) 2025-2026 Fred Gilham
  3. ;; Author: Fred Gilham <fmgilham@gmail.com>
  4. ;; Version: 1.2.0
  5. ;; Keywords: files, text, hypermedia
  6. ;; Package-Requires: ((emacs "29.1") cl-lib dom shr)
  7. ;; URL: https://gitbot.homedns.org/fred/bible
  8. ;; This file is not part of GNU Emacs.
  9. ;; bible.el is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 3, or (at your option)
  12. ;; any later version.
  13. ;; bible.el is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  16. ;; General Public License for more details.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this file; see the file LICENSE. If not, see
  19. ;; <https://www.gnu.org/licenses/>.
  20. ;;; Commentary:
  21. ;; Forked and extensively modified from package by Zacalot
  22. ;; Url: https://github.com/Zacalot/bible-mode
  23. ;; This package uses the `diatheke' program to browse and search
  24. ;; Biblical texts provided by the Sword project (https://crosswire.org).
  25. ;; Word study is also supported.
  26. ;;;; Usage
  27. ;; Use M-x `bible-open' to open a Bible buffer.
  28. ;; Use C-h f `bible' to see available keybindings.
  29. ;; The program also installs a Bible menu with keybindings and other
  30. ;; commands.
  31. ;; You may customize `bible-text' to set a default browsing
  32. ;; module, as well as `bible-word-study-enabled' to enable word
  33. ;; study by default.
  34. ;;;; Design
  35. ;; The idea here is to use the diatheke program to lookup text from
  36. ;; modules (biblical texts), then insert this text into buffers. The
  37. ;; main bible display uses diatheke's internal XML format. The whole
  38. ;; buffer gets parsed by `libxml-parse-html-region' to create a dom
  39. ;; tree. This gets parsed by `bible--insert-domnode-recursive' to render
  40. ;; the text into reading format.
  41. ;; The text is then decorated using information from the dom format as
  42. ;; necessary along with regular expressions to identify the verse
  43. ;; references. This is for red letters, purple highlighting of the
  44. ;; verse numbers, bold face of the divine name in the OT and so on.
  45. ;; If Strongs tags and/or morphological tags are present, they are
  46. ;; looked up in appropriate lexical and morphological modules and used
  47. ;; to add tooltips to the text so that hovering over words will bring
  48. ;; up a tooltip with information about the word. Clicking on a word
  49. ;; with lexical information will display that information in a "term"
  50. ;; buffer.
  51. ;;; Code:
  52. ;;;; Environment stuff
  53. ;; Turn off tool bar mode because we are greedy for pixels....
  54. (tool-bar-mode -1)
  55. ;; eldoc isn't meaningful in this program, and this saves space in the
  56. ;; mode line.
  57. (global-eldoc-mode -1)
  58. ;;;; Requirements
  59. (require 'cl-lib)
  60. (require 'dom)
  61. (require 'shr)
  62. ;;;; Aliases for obsolete functions
  63. ;; dom-text and dom-texts declared obsolescent in Emacs 31. Check for
  64. ;; new function, retain backward compatibility.
  65. (defalias 'bible-dom-text (if (fboundp 'dom-inner-text) 'dom-inner-text 'dom-text))
  66. (defalias 'bible-dom-texts (if (fboundp 'dom-inner-text) 'dom-inner-text 'dom-texts))
  67. ;;;; Configuration Variables
  68. (defgroup bible nil
  69. "Settings for `bible'."
  70. :group 'tools
  71. :link '(url-link "https://gitbot.homedns.org/fred/bible-mode"))
  72. (defcustom bible-text
  73. "KJV"
  74. "Customize default bible text module for Diatheke to query.
  75. \(For full list of installed modules, run `diatheke -b system -l bibliography'\)"
  76. :type '(choice (const :tag "None" nil)
  77. (string :tag "Bible text (e.g. \"KJV\")"))
  78. :local nil
  79. :group 'bible)
  80. (defcustom bible-commentary
  81. "Clarke"
  82. "Customize default commentary module for Diatheke to query.
  83. \(For full list of installed modules, run `diatheke -b system -l bibliography'\)"
  84. :type '(choice (const :tag "None" nil)
  85. (string :tag "Commentary (e.g. \"Clarke\")"))
  86. :local nil
  87. :group 'bible)
  88. ;; TODO: Not implememted yet (FMG 5-Mar-2026)
  89. (defcustom bible-font
  90. "Ezra SIL"
  91. "Default font for bible (not yet implemented)."
  92. :type '(string :tag "Font family name (e.g. \"Ezra SIL\")")
  93. :local t
  94. :group 'bible)
  95. (defcustom bible-sword-query
  96. "diatheke"
  97. "Specify program used to query sword modules.
  98. Must be some version of the sword library's diatheke program."
  99. :type '(string :tag "Sword library query executable (e.g. \"/usr/local/bin/diatheke\").")
  100. :local nil
  101. :group 'bible)
  102. (defcustom bible-greek-lexicon
  103. ;; AbbottSmithStrongs now has both links to lemmas and definitions
  104. ;; keyed by lemma. So we only need the AbbottSmithStrongs lexicon
  105. ;; and not the AbbottSmith lexicon.
  106. "AbbottSmithStrongs"
  107. "Lexicon used for displaying definitions of Greek words using Strong's codes."
  108. :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
  109. :local nil
  110. :group 'bible)
  111. (defcustom bible-use-index-for-lexicon t
  112. "Some lexicons are accessed by lemmas rather than Strong's numbers.
  113. Use an index to look up lemmas from Strong's numbers so these lexicons
  114. can be used."
  115. :type 'boolean
  116. :local nil
  117. :group 'bible)
  118. (defcustom bible-lexicon-index "AbbottSmithStrongs"
  119. "A module that consists of an index mapping Strong's numbers to Greek lemmas.
  120. The code is written to use the entries in AbbottSmithStrongs
  121. which are of the form
  122. <strong's number>: @LINK <greek lemma>"
  123. :type '(string :tag "Lexicon index.")
  124. :local nil
  125. :group 'bible)
  126. (defcustom bible-greek-lexicon-short
  127. "StrongsRealGreek"
  128. "Lexicon used for displaying definitions of Greek words in tooltips."
  129. :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
  130. :local nil
  131. :group 'bible)
  132. ;; HACK: The Hebrew lexicons differ on whether they accept keys of the
  133. ;; form `Hnnnn' or `nnnn'. The code does not yet handle this
  134. ;; correctly, so stick with the following. (FMG 5-Mar-2026)
  135. (defcustom bible-hebrew-lexicon
  136. "BDBGlosses_Strongs" ; This seems to work
  137. "Specify Lexicon used to display definitions of Hebrew words.
  138. Note that changing this may require changing some code.
  139. See `bible--display-lemma-hebrew'."
  140. :type '(string :tag "Lexicon module (e.g. \"BDBGlosses_Strongs\")")
  141. :local nil
  142. :group 'bible)
  143. (defcustom bible-hebrew-lexicon-short
  144. "StrongsRealHebrew"
  145. ;; "StrongsHebrew"
  146. "Lexicon used for displaying definitions of Hebrew words in tooltips."
  147. :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
  148. :local nil
  149. :group 'bible)
  150. (defcustom bible-word-study-enabled
  151. nil
  152. "Display original language Lemma words if present in module.
  153. \(KJV New Testament has this.\)"
  154. :type 'boolean
  155. :local t
  156. :group 'bible)
  157. (defcustom bible-red-letter-enabled
  158. t
  159. "Display words of Jesus in red when module has that information."
  160. :type 'boolean
  161. :local t
  162. :group 'bible)
  163. (defcustom bible-show-diatheke-exec
  164. nil
  165. "Show the arguments by which diatheke is executed (mostly for debugging)."
  166. :type 'boolean
  167. :local nil
  168. :group 'bible)
  169. ;;;; Variable definitions
  170. (defvar bible--text-buffers nil
  171. "List of Bible text buffers.")
  172. (defvar bible--commentary-buffers nil
  173. "List of commentary buffers.")
  174. (defvar bible--synced-buffers nil
  175. "List of buffers that are synchronized so that navigation in one applies
  176. to all of them.")
  177. (defvar-local bible--synced-p nil
  178. "Is this buffer syncronized?")
  179. (defvar bible-mode-line-format
  180. '("%e" mode-line-front-space
  181. mode-line-frame-identification mode-line-buffer-identification " "
  182. bible-text
  183. " "
  184. bible--current-book-name
  185. " " (:eval (number-to-string bible--current-chapter))
  186. " " (:eval (if bible--synced-p "Sync" ""))
  187. " " mode-line-modes mode-line-misc-info
  188. mode-line-end-spaces)
  189. "Mode line format for bible buffers.")
  190. (defvar bible-search-mode-line-format
  191. '("%e" mode-line-front-space
  192. mode-line-frame-identification mode-line-buffer-identification " "
  193. bible-text " " bible-search-word " "
  194. (:eval (number-to-string bible-search-matches)) " matches"
  195. " " mode-line-modes mode-line-misc-info
  196. mode-line-end-spaces)
  197. "Mode line format for bible search buffers.")
  198. (defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
  199. (defvar bible--texts (lazy-completion-table bible--texts bible--list-biblical-texts))
  200. (defvar bible--commentaries (lazy-completion-table bible--commentaries bible--list-biblical-commentaries))
  201. ;; REVIEW: I believe these chapter counts aren't the same for all modules, e.g. JPS. (FMG 5-Mar-2026)
  202. (defvar bible--books
  203. '(;; Old Testament
  204. ("Genesis" . 50) ("Exodus" . 40) ("Leviticus" . 27) ("Numbers" . 36)
  205. ("Deuteronomy" . 34) ("Joshua" . 24) ("Judges" . 21) ("Ruth" . 4)
  206. ("I Samuel" . 31) ("II Samuel" . 24) ("I Kings" . 22) ("II Kings" . 25)
  207. ("1 Samuel" . 31) ("2 Samuel" . 24) ("1 Kings" . 22) ("2 Kings" . 25)
  208. ("I Chronicles" . 29) ("II Chronicles" . 36) ("Ezra" . 10) ("Nehemiah" . 13)
  209. ("1 Chronicles" . 29) ("2 Chronicles" . 36)
  210. ("Ezra" . 10) ("Nehemiah" . 13)
  211. ("Esther" . 10) ("Job" . 42) ("Psalms" . 150) ("Proverbs" . 31)
  212. ("Ecclesiastes" . 12) ("Song of Solomon" . 8) ("Isaiah" . 66) ("Jeremiah" . 52)
  213. ("Lamentations" . 5) ("Ezekiel" . 48) ("Daniel" . 12) ("Hosea" . 14)
  214. ("Joel" . 3) ("Amos" . 9) ("Obadiah" . 1) ("Jonah" . 4)
  215. ("Micah" . 7) ("Nahum" . 3) ("Habakkuk" . 3) ("Zephaniah" . 3)
  216. ("Haggai" . 2) ("Zechariah" . 14) ("Malachi" . 4)
  217. ;; New Testament
  218. ("Matthew" . 28) ("Mark" . 16) ("Luke" . 24) ("John" . 21)
  219. ("Acts" . 28) ("Romans" . 16)
  220. ("I Corinthians" . 16) ("II Corinthians" . 13)
  221. ("1 Corinthians" . 16) ("2 Corinthians" . 13)
  222. ("Galatians" . 6) ("Ephesians" . 6) ("Philippians" . 4) ("Colossians" . 4)
  223. ("I Thessalonians" . 5) ("II Thessalonians" . 3) ("I Timothy" . 6) ("II Timothy" . 4)
  224. ("1 Thessalonians" . 5) ("2 Thessalonians" . 3) ("1 Timothy" . 6) ("2 Timothy" . 4)
  225. ("Titus" . 3) ("Philemon" . 1) ("Hebrews" . 13) ("James" . 5)
  226. ("I Peter" . 5) ("II Peter" . 3) ("I John" . 5) ("II John" . 1)
  227. ("1 Peter" . 5) ("2 Peter" . 3) ("1 John" . 5) ("2 John" . 1)
  228. ("III John" . 1) ("Jude" . 1) ("Revelation of John" . 22)
  229. ("3 John" . 1))
  230. "A-list of name / chapter count for Bible books.")
  231. ;; These abbreviations are used to follow cross-references in commentaries and lexicons.
  232. ;; Abbreviations from NETnote module and Clarke module (commentaries).
  233. ;; Abbreviations from some lexicons.
  234. ;; Standard abbreviations come first.
  235. (defvar bible--book-name-abbreviations
  236. '(;; Old Testament
  237. ("Gen" . "Genesis") ("Ge" . "Genesis")
  238. ("Exod" . "Exodus") ("Ex" . "Exodus") ("Exo" . "Exodus")
  239. ("Lev" . "Leviticus") ("Le" . "Leviticus")
  240. ("Num" . "Numbers") ("Nu" . "Numbers")
  241. ("Deut" . "Deuteronomy") ("De" . "Deuteronomy") ("Deu" . "Deuteronomy")
  242. ("Josh" . "Joshua") ("Js" . "Joshua") ("Jos" . "Joshua")
  243. ("Judg" . "Judges") ("Jg" . "Judges") ("Jdg" . "Judges")
  244. ("Ru" . "Ruth") ("Rut" . "Ruth")
  245. ("1 Sam" . "I Samuel") ("1 Samuel" . "I Samuel") ("I Sa" . "I Samuel") ("1 Sa" . "I Samuel") ("1Sam" . "I Samuel")
  246. ("2 Sam" . "II Samuel") ("2 Samuel" . "II Samuel") ("II Sa" . "II Samuel") ("2 Sa" . "II Samuel") ("2Sam" . "II Samuel")
  247. ("1 Kgs" . "I Kings") ("1 Kings" . "I Kings") ("I Ki" . "I Kings") ("1 Ki" . "I Kings") ("1Ki" . "I Kings")
  248. ("2 Kgs" . "II Kings") ("2 Kings" . "II Kings") ("II Ki" . "II Kings") ("2 Ki" . "II Kings") ("2Ki" . "II Kings")
  249. ("1 Chr" . "I Chronicles") ("1 Chronicles" . "I Chronicles") ("I Ch" . "I Chronicles") ("1 Ch" . "I Chronicles")
  250. ("2 Chr" . "II Chronicles") ("2 Chronicles" . "II Chronicles") ("II Ch" . "II Chronicles") ("2 Ch" . "II Chronicles")
  251. ("Ezr" . "Ezra")
  252. ("Neh" . "Nehemiah") ("Ne" . "Nehemiah")
  253. ("Esth" . "Esther") ("Es" . "Esther") ("Est" . "Esther")
  254. ("Jb" . "Job")
  255. ("Ps" . "Psalms") ("Psa" . "Psalms")
  256. ("Prov" . "Proverbs") ("Pr" . "Proverbs") ("Pro" . "Proverbs")
  257. ("Eccl" . "Ecclesiastes") ("Ec" . "Ecclesiastes") ("Ecc" . "Ecclesiastes")
  258. ("Song" . "Song of Solomon") ("So" . "Song of Solomon") ("Sol" . "Song of Solomon")
  259. ("Isa" . "Isaiah") ("Is" . "Isaiah")
  260. ("Jer" . "Jeremiah") ("Je" . "Jeremiah")
  261. ("Lam" . "Lamentations") ("La" . "Lamentations")
  262. ("Ezek" . "Ezekiel") ("Ez" . "Ezekiel") ("Eze" . "Ezekiel")
  263. ("Dan" . "Daniel") ("Da" . "Daniel")
  264. ("Hos" . "Hosea") ("Ho" . "Hosea")
  265. ("Joe" . "Joel")
  266. ("Am" . "Amos") ("Amo" . "Amos")
  267. ("Obad" . "Obadiah") ("Ob" . "Obadiah") ("Oba" . "Obadiah")
  268. ("Jon" . "Jonah")
  269. ("Mic" . "Micah") ("Mi" . "Micah")
  270. ("Nah" . "Nahum") ("Na" . "Nahum")
  271. ("Hab" . "Habakkuk") ("Ha" . "Habakkuk")
  272. ("Zeph" . "Zephaniah") ("Zep" . "Zephaniah")
  273. ("Hag" . "Haggai")
  274. ("Zech" . "Zechariah") ("Ze" . "Zechariah") ("Zac" . "Zechariah") ;; Is the last one correct??
  275. ("Mal" . "Malachi")
  276. ;; New Testament
  277. ("Mt" . "Matthew") ("Mat" . "Matthew") ("Matt" . "Matthew")
  278. ("Mk" . "Mark") ("Mar" . "Mark")
  279. ("Lk" . "Luke") ("Luk" . "Luke")
  280. ("Jn" . "John") ("Jo" . "John") ("Joh" . "John")
  281. ("Ac" . "Acts") ("Act" . "Acts")
  282. ("Rom" . "Romans") ("Ro" . "Romans")
  283. ("1 Cor" . "I Corinthians") ("1 Corintihans" . "I Corinthians") ("I Co" . "I Corinthians") ("1 Co" . "I Corinthians")
  284. ("ICor" . "I Corinthians") ("1Cor" . "I Corinthians")
  285. ("2 Cor" . "II Corinthians") ("2 Corinthians" . "II Corinthians") ("II Co" . "II Corinthians") ("2 Co" . "II Corinthians")
  286. ("IICor" . "II Corinthians") ("2Cor" . "II Corinthians")
  287. ("Gal" . "Galatians") ("Ga" . "Galatians")
  288. ("Eph" . "Ephesians")
  289. ("Phil" . "Philippians") ("Phl" . "Philippians")
  290. ("Col" . "Colossians")
  291. ("1 Thess" . "I Thessalonians") ("1 Thessalonians" . "I Thessalonians") ("I Th" . "I Thessalonians") ("1 Th" . "I Thessalonians")
  292. ("IThess" . "I Thessalonians") ("1Thes" . "I Thessalonians") ("1Thess" . "I Thessalonians")
  293. ("2 Thess" . "II Thessalonians") ("2 Thessalonians" . "II Thessalonians") ("II Th" . "II Thessalonians") ("2 Th" . "II Thessalonians")
  294. ("IIThess" . "II Thessalonians") ("2Thes" . "II Thessalonians") ("2Thess" . "II Thessalonians")
  295. ("1 Tim" . "I Timothy") ("1 Timothy" . "I Timothy") ("I Ti" . "I Timothy") ("1 Ti" . "I Timothy") ("ITim" . "I Timothy")
  296. ("1Tim" . "I Timothy")
  297. ("2 Tim" . "II Timothy") ("2 Timothy" . "II Timothy") ("II Ti" . "II Timothy") ("2 Ti" . "II Timothy") ("IITim" . "II Timothy")
  298. ("2Tim" . "II Timothy")
  299. ("Tit" . "Titus")
  300. ("Phlm" . "Philemon") ("Phm" . "Philemon") ("Plm" . "Philemon")
  301. ("Heb" . "Hebrews") ("He" . "Hebrews")
  302. ("Jas" . "James") ("Ja" . "James") ("Jam" . "James")
  303. ("1 Pet" . "I Peter") ("1 Peter" . "I Peter") ("I Pe" . "I Peter") ("1 Pe" . "I Peter") ("IPet" . "I Peter") ("1Pet" . "I Peter")
  304. ("2 Pet" . "II Peter") ("2 Peter" . "II Peter") ("II Pe" . "II Peter") ("2 Pe" . "II Peter") ("IIPet" . "II Peter") ("2Pet" . "II Peter")
  305. ("1 Jn" . "I John") ("1 John" . "I John") ("I Jo" . "I John") ("1 Jo" . "I John") ("IJohn" . "I John") ("1Jn" . "I John")
  306. ("2 Jn" . "I John") ("2 John" . "II John") ("II Jo" . "II John") ("2 Jo" . "II John") ("IIJohn" . "II John") ("2Jn" . "I John")
  307. ("3 Jn" . "I John") ("3 John" . "III John") ("III Jo" . "III John") ("3 Jo" . "III John") ("IIIJohn" . "III John") ("3Jn" . "I John")
  308. ("Ju" . "Jude") ("Jde" . "Jude")
  309. ("Rev" . "Revelation of John") ("Re" . "Revelation of John"))
  310. "A-list of abbreviations for Bible books.")
  311. ;;;;; Book / chapter
  312. (defvar-local bible--current-book (assoc "Genesis" bible--books)
  313. "Current book data (name . chapter).")
  314. (defvar-local bible--current-book-name "Genesis"
  315. "Current book name.")
  316. (defvar-local bible--current-chapter 1
  317. "Current book chapter number.")
  318. ;;;;; Search / query
  319. (defvar-local bible-query nil
  320. "Search query associated with the buffer.")
  321. (defvar-local bible-search-mode "phrase"
  322. "Search mode: either `lucene', `phrase', `regex' or `multiword'.")
  323. (defvar bible-search-range nil)
  324. ;;;;; Lexemes / morphemes
  325. (defvar-local bible-has-lexemes nil
  326. "Set if the module being displayed has lexical entries availabile.")
  327. (defvar-local bible-has-morphemes nil
  328. "Set if the module being displayed has morphemes availabile.")
  329. ;;;; Keymaps
  330. ;; N.B. Bible Menu items appear in reverse order of their definition
  331. ;; below
  332. (defconst bible-map (make-sparse-keymap)
  333. "Keymap for bible.")
  334. (define-key bible-map [menu-bar bible]
  335. (cons "Bible" (make-sparse-keymap "Bible")))
  336. (define-key bible-map
  337. [menu-bar bible toggle-debug]
  338. '("Toggle debug-on-error" . toggle-debug-on-error))
  339. (define-key bible-map
  340. [menu-bar bible display-diatheke]
  341. '("Toggle diatheke display" . bible-toggle-display-diatheke))
  342. (defvar-local bible-debugme nil
  343. "Make text show up as XML when set.")
  344. (define-key bible-map "d" 'bible-toggle-display-xml)
  345. (define-key bible-map
  346. [menu-bar bible display-xml]
  347. '("Toggle XML Display" . bible-toggle-display-xml))
  348. (define-key bible-map
  349. [menu-bar bible sep]
  350. '(menu-item '"--"))
  351. ;;;;; Misc key bindings
  352. (define-key bible-map "T" 'bible-select-text)
  353. (define-key bible-map "C" 'bible-select-commentary)
  354. (define-key bible-map "w" 'bible-toggle-word-study)
  355. (define-key bible-map "l" 'bible-toggle-red-letter)
  356. (define-key bible-map "z" 'text-scale-adjust)
  357. (define-key bible-map
  358. [menu-bar bible zoom-text]
  359. '("Zoom Text" . text-scale-adjust))
  360. (define-key bible-map "x" 'bible-split-display)
  361. (define-key bible-map
  362. [menu-bar bible split-display]
  363. '("Split Display" . bible-split-display))
  364. (define-key bible-map "S" 'bible-toggle-buffer-sync)
  365. (define-key bible-map [menu-bar bible sync]
  366. '("Toggle Synchronize Buffer" . bible-toggle-buffer-sync))
  367. ;;;;; Navigation
  368. (define-key bible-map "p" 'bible-previous-chapter)
  369. (define-key bible-map
  370. [menu-bar bible previous-chapter]
  371. '("Previous Chapter" . bible-previous-chapter))
  372. (define-key bible-map "n" 'bible-next-chapter)
  373. (define-key bible-map
  374. [menu-bar bible next-chapter]
  375. '("Next Chapter" . bible-next-chapter))
  376. (define-key bible-map (kbd "TAB") 'bible-next-word)
  377. (define-key bible-map (kbd "M-<tab>") 'bible-previous-word)
  378. ;;;;; Direct jump
  379. (define-key bible-map "c" 'bible-select-chapter)
  380. (define-key bible-map
  381. [menu-bar bible select-chapter]
  382. '("Select Chapter" . bible-select-chapter))
  383. (define-key bible-map "b" 'bible-select-book)
  384. (define-key bible-map
  385. [menu-bar bible select-book]
  386. '("Select Book" . bible-select-book))
  387. (define-key bible-map
  388. [menu-bar bible sep]
  389. '(menu-item '"--"))
  390. ;; Deal with visual-line-mode navigation.
  391. (define-key bible-map "\C-n" 'next-logical-line)
  392. (define-key bible-map "\C-p" 'previous-logical-line)
  393. ;;;;; Search
  394. (define-key bible-map "/" 'bible-search)
  395. (define-key bible-map "s" 'bible-search)
  396. (define-key bible-map
  397. [menu-bar bible search]
  398. '("Search" . bible-search))
  399. (define-key bible-map "r" 'bible-set-search-range)
  400. (define-key bible-map
  401. [menu-bar bible range]
  402. '("Set Search Range" . bible-set-search-range))
  403. (defconst bible-search-mode-map (make-keymap))
  404. (define-key bible-search-mode-map "s" 'bible-search)
  405. (define-key bible-search-mode-map "w" 'bible-toggle-word-study)
  406. (define-key bible-search-mode-map "n" 'bible-next-search-item)
  407. (define-key bible-search-mode-map "p" 'bible-previous-search-item)
  408. (define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
  409. (define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-verse)
  410. ;;;;; Term display
  411. (defconst bible-term-mode-map (make-sparse-keymap))
  412. (define-key bible-term-mode-map "z" 'text-scale-adjust)
  413. (define-key bible-term-mode-map [mouse-1] 'bible-search-mode-follow-xref)
  414. (defun bible-toggle-display-diatheke ()
  415. "Toggle diatheke args display."
  416. (interactive)
  417. (setq bible-show-diatheke-exec (not bible-show-diatheke-exec))
  418. (message ""))
  419. (defun bible-next-search-item ()
  420. "Go to next item in list of found verses."
  421. (interactive)
  422. (search-forward-regexp bible--verse-regexp))
  423. (defun bible-previous-search-item ()
  424. "Go to previous item in list of found verses."
  425. (interactive)
  426. (search-backward-regexp bible--verse-regexp))
  427. (defun bible-toggle-display-xml ()
  428. "Toggle XML display."
  429. (interactive)
  430. (setq-local bible-debugme (not bible-debugme))
  431. (bible--display))
  432. (defvar-local bible-text-direction 'left-to-right)
  433. (defun bible-toggle-text-direction ()
  434. "Switch between left-to-right and right-to-left text direction."
  435. (interactive)
  436. (if (eq bible-text-direction 'left-to-right)
  437. (setq-local bible-text-direction 'right-to-left)
  438. (setq-local bible-text-direction 'left-to-right))
  439. (setq-local bidi-paragraph-direction bible-text-direction))
  440. (defvar-local bible-search-query nil
  441. "Query used in toggles (word study and red letter).")
  442. (defvar bible-use-tooltips t)
  443. (setq tooltip-delay 1)
  444. (setq tooltip-short-delay .5)
  445. (setq use-system-tooltips nil)
  446. ;;(setq tooltip-mode -1)
  447. ;;(setq tooltip-resize-echo-area t)
  448. (defun bible-toggle-tooltips ()
  449. "Toggle use of tooltips to display lexical/morphological items."
  450. (interactive)
  451. (setq bible-use-tooltips (not bible-use-tooltips))
  452. (tooltip-mode 'toggle)
  453. (setq tooltip-resize-echo-area (not bible-use-tooltips))
  454. (setq bible-show-diatheke-exec (and bible-show-diatheke-exec bible-use-tooltips)) ; Don't conflict with echo area
  455. (message ""))
  456. (define-key bible-map
  457. [menu-bar bible sepp]
  458. '(menu-item '"--"))
  459. (define-key bible-map
  460. [menu-bar bible toggle-text-direction]
  461. '("Toggle text direction (for Hebrew display)" . bible-toggle-text-direction))
  462. (define-key bible-map
  463. [menu-bar bible toggle-tooltip-display]
  464. '("Toggle Tooltip Display" . bible-toggle-tooltips))
  465. (define-key bible-map
  466. [menu-bar bible sepp]
  467. '(menu-item '"--"))
  468. (define-key bible-map
  469. [menu-bar bible select-biblical-commentary]
  470. '("Select Commentary" . bible-display-available-commentaries))
  471. (define-key bible-map
  472. [menu-bar bible select-biblical-text]
  473. '("Select Text" . bible-display-available-texts))
  474. ;;;; Terms
  475. (defun bible--display-greek ()
  476. "Display Greek term.
  477. This command is run by clicking on text, not directly by the user."
  478. (interactive)
  479. (let ((item (car (split-string (get-text-property (point) 'strong)))))
  480. ;; Remove "strong:G" prefix
  481. (bible-term-greek (replace-regexp-in-string "strong:G" "" item))))
  482. (defconst bible-greek-keymap (make-sparse-keymap))
  483. (define-key bible-greek-keymap (kbd "RET") 'bible--display-greek)
  484. (define-key bible-greek-keymap [mouse-1] 'bible--display-greek)
  485. (defun bible--display-hebrew ()
  486. "Display Hebrew term.
  487. This command is run by clicking on text, not directly by the user."
  488. (interactive)
  489. (let ((item (car (split-string (get-text-property (point) 'strong)))))
  490. ;; Remove "strong:H" prefix and any alphabetic suffixes.
  491. (bible-term-hebrew (replace-regexp-in-string "strong:H" "" item))))
  492. (defconst bible-hebrew-keymap (make-sparse-keymap))
  493. (define-key bible-hebrew-keymap (kbd "RET") 'bible--display-hebrew)
  494. (define-key bible-hebrew-keymap [mouse-1] 'bible--display-hebrew)
  495. (defconst bible-lemma-keymap (make-sparse-keymap))
  496. (define-key bible-lemma-keymap (kbd "RET")
  497. (lambda ()
  498. (interactive)))
  499. ;; Not used. Not really sure what to do here or if it's useful to do anything.
  500. (defconst bible-morph-keymap (make-sparse-keymap))
  501. (define-key bible-morph-keymap (kbd "RET")
  502. (lambda ()
  503. (interactive)
  504. ;; (let ((thing (thing-at-point 'word)))
  505. ;; (message "thing at point: %s" thing)
  506. ;; (message "morph property %s" (get-text-property 0 'field thing))
  507. ))
  508. ;;;; Modes
  509. (define-derived-mode bible special-mode "Bible"
  510. "Mode for reading the Bible.
  511. \\{bible-map}"
  512. (buffer-disable-undo)
  513. (font-lock-mode t)
  514. (use-local-map bible-map)
  515. (setq buffer-read-only t)
  516. (visual-line-mode t))
  517. (define-derived-mode bible-search-mode special-mode "Bible Search"
  518. "Mode for performing Bible searches.
  519. \\{bible-search-mode-map}"
  520. (buffer-disable-undo)
  521. (font-lock-mode t)
  522. (use-local-map bible-search-mode-map)
  523. (setq buffer-read-only t)
  524. (visual-line-mode t))
  525. (define-derived-mode bible-term-mode special-mode "Bible Term"
  526. "Mode for researching terms in the Bible.
  527. \\{bible-term-mode-map}"
  528. (buffer-disable-undo)
  529. (font-lock-mode t)
  530. (use-local-map bible-term-mode-map)
  531. (setq buffer-read-only t)
  532. (visual-line-mode t))
  533. (define-derived-mode bible-term-hebrew-mode bible-term-mode "Bible Term (Hebrew)"
  534. "Mode for researching Hebrew terms in the Bible.
  535. \\{bible-term-hebrew-mode-map}")
  536. (define-derived-mode bible-term-greek-mode bible-term-mode "Bible Term (Greek)"
  537. "Mode for researching Greek terms in the Bible.
  538. \\{bible-term-greek-mode-map}")
  539. (define-derived-mode bible-text-select-mode special-mode "Select Module"
  540. (buffer-disable-undo)
  541. (font-lock-mode t)
  542. (setq buffer-read-only t))
  543. ;;;; Functions
  544. ;;;;; Commands (interactive)
  545. (defun bible-open (&optional book-name chapter verse module)
  546. "Create and open a `bible' buffer.
  547. Optional arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the
  548. starting verse reference for the buffer. If no optional location
  549. arguments are supplied, Genesis 1:1 is used. Optional argument MODULE
  550. specifies the module to use."
  551. (interactive)
  552. (with-current-buffer (get-buffer-create (generate-new-buffer-name "*bible*"))
  553. (bible)
  554. (setq-local mode-line-format bible-mode-line-format)
  555. (when module (setq-default bible-text module))
  556. (setq-local bible-text (default-value 'bible-text))
  557. (bible--set-location
  558. (assoc (or book-name "Genesis") bible--books)
  559. (or chapter 1)
  560. verse)
  561. (cl-pushnew (current-buffer) bible--text-buffers)
  562. (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
  563. ;;;;;; Navigation
  564. (defun bible-next-chapter ()
  565. "Page to the next chapter for the active `bible' buffer and
  566. for any synchronized buffers."
  567. (interactive)
  568. (let* ((book-chapters (cdr bible--current-book))
  569. (chapter (min book-chapters (1+ bible--current-chapter))))
  570. (bible--set-location bible--current-book chapter)))
  571. (defun bible-previous-chapter ()
  572. "Page to the previous chapter for the active `bible' buffer and
  573. for any synchronized buffers."
  574. (interactive)
  575. (bible--set-location bible--current-book (max 1 (1- bible--current-chapter))))
  576. (defun bible-next-word ()
  577. "Move forward a word, taking into account the relevant text properties."
  578. (interactive)
  579. (unless (eobp)
  580. (let ((next-change (text-property-search-forward 'strong nil nil t)))
  581. (when next-change
  582. (goto-char (1- (prop-match-end next-change)))))))
  583. (defun bible-previous-word ()
  584. "Move back a word, taking into account the relevant text properties."
  585. (interactive)
  586. (unless (bobp)
  587. (let ((previous-change (text-property-search-backward 'strong)))
  588. (when previous-change
  589. (goto-char (prop-match-beginning previous-change))))))
  590. ;;;;;; Select Location
  591. (defun bible-select-book ()
  592. "Ask user for a new book and chapter for the current `bible' buffer."
  593. (interactive)
  594. (let* ((completion-ignore-case t)
  595. (book-data (assoc (completing-read "Book: " bible--books nil t) bible--books))
  596. (book-data-string (car book-data))
  597. (chapter (string-to-number
  598. (completing-read
  599. "Chapter [1]: "
  600. (bible--list-number-range 1 (cdr book-data)) nil t nil nil "1"))))
  601. (pcase (aref book-data-string 0)
  602. (?1 (setq book-data (cons (concat "I" (substring book-data-string 1)) (cdr book-data))))
  603. (?2 (setq book-data (cons (concat "II" (substring book-data-string 1)) (cdr book-data))))
  604. (?3 (setq book-data (cons (concat "III" (substring book-data-string 1)) (cdr book-data)))))
  605. (bible--set-location book-data chapter)))
  606. (defun bible-select-chapter ()
  607. "Ask user for a new chapter for the current `bible' buffer."
  608. (interactive)
  609. (let* ((book-chapters (cdr bible--current-book))
  610. (chapter (string-to-number
  611. (completing-read
  612. "Chapter [1]: "
  613. (bible--list-number-range 1 book-chapters) nil t nil nil "1"))))
  614. (when chapter
  615. (bible--set-location bible--current-book chapter))))
  616. ;;;;;; Select modules
  617. ;; Choose a module.
  618. (defun bible-pick-module ()
  619. "Keymap action function---select module that the user chooses."
  620. (interactive)
  621. (let ((item (get-text-property (point) 'module)))
  622. (bible-open bible--current-book-name bible--current-chapter 1 item)))
  623. (defun bible-select-text ()
  624. "Ask user for a new text module for the current `bible' buffer."
  625. (interactive)
  626. (let ((text (completing-read "Text: " bible--texts)))
  627. (unless (string= text "")
  628. (setq-default bible-text text)
  629. (setq-local bible-text text)
  630. (bible--display))))
  631. (defun bible-select-commentary ()
  632. "Ask user for a new text module for the current `bible' buffer."
  633. (interactive)
  634. (let ((commentary (completing-read "Commentary: " bible--commentaries)))
  635. (unless (string= commentary "")
  636. (setq-local bible-text commentary)
  637. (bible--display))))
  638. ;;;;;; Toggles
  639. (defun bible-toggle-word-study ()
  640. "Toggle the inclusion of word study for the active `bible' buffer."
  641. (interactive)
  642. (setq bible-word-study-enabled (not bible-word-study-enabled))
  643. (bible--display))
  644. (defun bible-toggle-red-letter ()
  645. "Toggle red letter mode for the active `bible' buffer."
  646. (interactive)
  647. (setq bible-red-letter-enabled (not bible-red-letter-enabled))
  648. (bible--display))
  649. (defun bible-toggle-buffer-sync ()
  650. "Either add or remove the current buffer from the
  651. `bible--synced-buffers' list."
  652. (interactive)
  653. (let ((buffer (current-buffer)))
  654. (if bible--synced-p
  655. (progn
  656. (setq bible--synced-buffers (cl-delete buffer bible--synced-buffers))
  657. (setq-local bible--synced-p nil))
  658. (cl-pushnew buffer bible--synced-buffers)
  659. (setq-local bible--synced-p t))
  660. (force-mode-line-update)))
  661. (defun bible-split-display ()
  662. "Copy the active `bible' buffer into a new buffer in another window."
  663. (interactive)
  664. (split-window-right)
  665. (balance-windows)
  666. (other-window 1)
  667. (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
  668. ;;;;;; Search helpers
  669. (defun bible-set-search-range ()
  670. "Ask user for a new text module for the current `bible' buffer."
  671. (interactive)
  672. (let ((range (read-string "Range (<return> to clear): ")))
  673. (if (string-equal range "")
  674. (setq bible-search-range nil)
  675. (setq bible-search-range range))))
  676. (defun bible-search (query)
  677. "Search for a QUERY: a word or phrase.
  678. Asks the user for type of search: either `lucene', `phrase', `regex'
  679. or `multiword'. `lucene' is the default search.
  680. `lucene' mode requires an index to be built using the `mkfastmod' program."
  681. (interactive "sBible Search: ")
  682. (when (> (length query) 0)
  683. (let ((searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
  684. (bible--open-search query searchmode (buffer-local-value 'bible-text (current-buffer))))))
  685. (defun bible-search-mode-follow-verse ()
  686. "Follow the hovered verse in a `bible-search-mode' buffer.
  687. Create a new `bible' buffer positioned at the selected verse."
  688. (interactive)
  689. (let* ((text (thing-at-point 'line t))
  690. book
  691. chapter
  692. verse)
  693. (when (string-match bible--verse-regexp text)
  694. (setq text (match-string 0 text))
  695. (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
  696. (setq book (match-string 0 text))
  697. (string-match "[0-9]?[0-9]?[0-9]?:" text)
  698. (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
  699. (string-match ":[0-9]?[0-9]?[0-9]?" text)
  700. (setq verse (substring (match-string 0 text) 1))
  701. (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse)) bible-text)))
  702. (defun bible-search-mode-follow-xref ()
  703. "Follow the hovered verse in a bible term buffer.
  704. Create a new `bible' buffer positioned at the specified verse.
  705. Handle abbreviations."
  706. (interactive)
  707. (let* ((xref (get-text-property (point) 'xref))
  708. (verse-ref (split-string xref))
  709. book-abbrev
  710. chapter-verse)
  711. (message "xref: %s" xref)
  712. (message "Verse-ref: %s" verse-ref)
  713. (cond ((= (length verse-ref) 2) ; Mat 5 or the like
  714. (setq book-abbrev (car verse-ref)
  715. chapter-verse (split-string (cadr verse-ref) ":")))
  716. ((= (length verse-ref) 3) ; II Cor 3:17 or the like
  717. (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
  718. chapter-verse (split-string (caddr verse-ref) ":"))))
  719. ;; Use book abbreviation if present or try whatever is in verse-ref.
  720. (let ((book (or (alist-get book-abbrev bible--book-name-abbreviations nil nil #'string-equal-ignore-case) (car verse-ref)))
  721. (chapter (car chapter-verse))
  722. (verse (cadr chapter-verse)))
  723. (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse) (default-value 'bible-text)))))
  724. ;;;;;; User visible actions.
  725. ;; These can be called interactively if you know the Strong's number
  726. ;; you want to look up.
  727. (defun bible-term-hebrew (term)
  728. "Query user for a Strong's Hebrew Lexicon TERM."
  729. (interactive "sTerm: ")
  730. (bible--open-term-hebrew term))
  731. (defun bible-term-greek (term)
  732. "Query user for a Strong's Greek Lexicon TERM."
  733. (interactive "sTerm: ")
  734. (bible--open-term-greek term))
  735. ;; Interactively insert a verse into an arbitrary current buffer.
  736. (defun bible-insert ()
  737. "Query user to select a verse for insertion into the current buffer."
  738. (interactive)
  739. (let* ((completion-ignore-case t)
  740. (book-data (assoc (completing-read "Book: " bible--books nil t) bible--books))
  741. (chapter (when book-data (completing-read "Chapter: " (bible--list-number-range 1 (cdr book-data)) nil t "1" nil "1")))
  742. (verse (when chapter (read-from-minibuffer "Verse: ")))
  743. (query (concat (car book-data) " " chapter ":" verse))
  744. (args (list bible-sword-query nil (current-buffer) t "-b" bible-text "-f" "plain" "-k" query)))
  745. (apply #'call-process args)))
  746. ;;;;;; Support (internal)
  747. ;; Don't know how to get footnotes and scripture cross references yet.
  748. ;;(defconst bible-diatheke-filter-options " afilmnsvw")
  749. (defconst bible-diatheke-filter-options " almnvw")
  750. (defun bible--exec-diatheke (query &optional filter format module)
  751. "Execute `diatheke' with specified QUERY options.
  752. FILTER is the Diatheke filter argument. FORMAT is either plain or
  753. the default of internal. MODULE is the text module to use. Returns
  754. string containing query result."
  755. (let ((module (or module bible-text)))
  756. (with-temp-buffer
  757. (let ((args (list bible-sword-query nil (current-buffer) t "-b" module)))
  758. (if filter
  759. (setq filter (concat filter bible-diatheke-filter-options))
  760. (setq filter bible-diatheke-filter-options))
  761. (setq args (append args (list "-o" filter)))
  762. (setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
  763. (when bible-show-diatheke-exec
  764. (message "%s" args))
  765. (apply #'call-process args))
  766. (buffer-string))))
  767. (defun bible--diatheke-search (query searchtype &optional format module)
  768. "Execute `diatheke' on QUERY with SEARCHTYPE.
  769. Optional argument FORMAT is either plain or the default of internal.
  770. MODULE is the text module to use and defaults to the current module."
  771. (with-temp-buffer
  772. (let ((args (list bible-sword-query nil (current-buffer) t "-b" (or module bible-text))))
  773. (setq args (append args (list "-s" (pcase searchtype
  774. ("lucene" "lucene")
  775. ("phrase" "phrase")
  776. ("regex" "regex")
  777. ("multiword" "multiword")))))
  778. (when bible-search-range (setq args (append args (list "-r" bible-search-range))))
  779. (setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
  780. (when bible-show-diatheke-exec
  781. (message "%s" args))
  782. (apply #'call-process args))
  783. (buffer-string)))
  784. (defvar-local bible-chapter-title nil
  785. "Text preceding start of chapter.
  786. Mostly in Psalms, like `Of David' or the like.")
  787. (defvar-local bible-level "0"
  788. "Used by some modules for indentation and line breaks.")
  789. ;;;; Greek and Hebrew lexeme and morpheme tooltip rendering.
  790. ;;;;; Hash tables for Lexical definitions.
  791. (defvar bible-hash-greek (make-hash-table :test 'equal :size 10000))
  792. (defvar bible-hash-hebrew (make-hash-table :test 'equal :size 10000))
  793. ;;;;; Hash tables for tooltips.
  794. (defvar lex-hash (make-hash-table :test 'equal :size 10000))
  795. (defvar morph-hash (make-hash-table :test 'equal :size 10000))
  796. ;; Use HTMLHREF format with diatheke, post-process to render html.
  797. (defun bible--morph-query (query module)
  798. "Execute `diatheke' to do morph QUERY, using MODULE.
  799. Render HTML, return string. Do some tweaking specific to morphology."
  800. (with-temp-buffer
  801. (let ((args (list bible-sword-query nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
  802. (when bible-show-diatheke-exec
  803. (message "%s" args))
  804. (apply #'call-process args)
  805. (shr-render-region (point-min) (point-max))
  806. (format-replace-strings
  807. '(("\n:" . "") ; This makes the Packard morphology display look better.
  808. ("Part of Speech" . "")) ; This helps the Robinson display look better.
  809. nil (point-min) (point-max))
  810. (substring (buffer-string) (1+ (length query)))))) ; This tries to get rid of unnecessary query identifier.
  811. ;; Use "plain" format with diatheke.
  812. (defun bible--lex-query (query module)
  813. "Execute `diatheke' for QUERY, using MODULE.
  814. Plain format, returns string."
  815. (bible--exec-diatheke query nil "plain" module))
  816. (defun bible--lookup-lemma-index (key)
  817. "Return the Greek lemma from lemma index with a strong's number as KEY."
  818. (string-trim
  819. (string-replace
  820. (concat "(" bible-lexicon-index)
  821. ""
  822. (bible--lex-query key bible-lexicon-index))))
  823. ;; The Greek lexical definitions are done using the HTMLHREF output
  824. ;; format so they come out looking nice and having clickable
  825. ;; cross-references and/or Strong's references.
  826. (defun bible--process-href ()
  827. "Fix the XML so cross-references are in the right format.
  828. These cross-references get processed later when the term is displayed.
  829. First, find the links put in by diatheke's HTMLHREF output format.
  830. Replace the links with verse references that get changed to clickable
  831. cross-references when the term is displayed.
  832. The verse refs look like this: <bookname>.<chapter>.<verse>. We convert
  833. them to the <bookname> <chapter>:<verse> format."
  834. (goto-char (point-min))
  835. (while (re-search-forward "<a href=\"passagestudy.*?</a>" nil t) ; HTMLHREF cross references.
  836. (let ((match-text (match-string 0)))
  837. ;; Delete original link.
  838. (replace-match "" nil nil)
  839. ;; Get the verse reference from the string we saved. Put it in
  840. ;; good format, then insert it into buffer where href was.
  841. (when (string-match "value=.*?&" match-text)
  842. (let* ((value-string (match-string 0 match-text))
  843. ;; Strip off value= and trailing &.
  844. (verse-ref-string (substring value-string 6 (1- (length value-string))))
  845. (verse-ref-length (length verse-ref-string))
  846. period)
  847. ;; Convert periods
  848. ;; Substitute first period with space
  849. (when (setq period (cl-search "." verse-ref-string))
  850. (aset verse-ref-string period ? ))
  851. ;; Substitute second period with colon
  852. (when (setq period (cl-search "." verse-ref-string))
  853. (aset verse-ref-string period ?:))
  854. ;; Replace numbers (1, 2 or 3) with roman numerals (I, II, III).
  855. (pcase (aref verse-ref-string 0)
  856. (?1 (setq verse-ref-string (concat "I" (substring verse-ref-string 1))))
  857. (?2 (setq verse-ref-string (concat "II" (substring verse-ref-string 1))))
  858. (?3 (setq verse-ref-string (concat "III" (substring verse-ref-string 1)))))
  859. (set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
  860. (insert verse-ref-string))))))
  861. (defvar bible-outline-strings
  862. '(;;(". ." . ".")
  863. (" I. ." . "\nI.")
  864. (" II. ." . " II.")
  865. (" III. ." . " III.")
  866. (" IV. ." . " IV.")
  867. (" V. ." . " V.")
  868. ("1. ." . "\n 1.")
  869. ("2. ." . "2.")
  870. ("3. ." . "3.")
  871. ("4. ." . "4.")
  872. ("5. ." . "5.")
  873. ("6. ." . "6.")
  874. ("7. ." . "7.")
  875. ("8. ." . "8.")
  876. ("9. ." . "9.")
  877. ("a. ." . "\n a.")
  878. ("(a)." . "\n (a).")
  879. ("b. ." . " b.")
  880. ("c. ." . " c.")
  881. ("d. ." . " d.")
  882. ("e. ." . " e.")
  883. ("f. ." . " f.")
  884. ("g. ." . " g.")
  885. ("h. ." . " h.")
  886. (" . " . ". ")
  887. ("\n\n" . "\n")))
  888. (defun bible--cleanup-lex-text (lex-text)
  889. "Reformat tooltip text LEX-TEXT so tooltips look nice."
  890. (dolist (outline-string bible-outline-strings)
  891. (setq lex-text (string-replace (car outline-string) (cdr outline-string) lex-text)))
  892. lex-text)
  893. (defun bible--lookup-def-greek (key)
  894. "Execute `diatheke' to do query on KEY.
  895. Massage output so verse cross references are usable. Returns string."
  896. (with-temp-buffer
  897. (let ((args (list bible-sword-query nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "plain" "-k" key)))
  898. (when bible-show-diatheke-exec
  899. (message "%s" args))
  900. (apply #'call-process args)
  901. (bible--cleanup-lex-text (bible--remove-module-name bible-greek-lexicon (buffer-string))))))
  902. (defun bible--lookup-lemma-greek-indexed (key)
  903. "Lookup Greek lemma using Strong's number KEY.
  904. Then look up the definition of that lemma. Used when two-stage
  905. lexical definition is set for a particular lexicon."
  906. (let ((lemma-entry (bible--lookup-lemma-index key))) ; Get lemma from Strong's number
  907. (when lemma-entry
  908. (let ((lemma (caddr (split-string lemma-entry " "))))
  909. (bible--lookup-def-greek lemma)))))
  910. (defun bible--lookup-lemma-greek (key)
  911. "Lookup lexical definition using Strong's number KEY.
  912. 1. Check hash table first. If entry found, return.
  913. 2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
  914. 3. Otherwise just use the Strong's number method."
  915. (or (gethash key bible-hash-greek)
  916. (puthash key
  917. (if bible-use-index-for-lexicon
  918. (bible--lookup-lemma-greek-indexed key)
  919. (bible--lookup-def-greek key))
  920. bible-hash-greek)))
  921. (defun bible--lookup-def-hebrew (key)
  922. "Execute `diatheke' to do query on KEY.
  923. Massage output so various cross references are usable. Returns string."
  924. (with-temp-buffer
  925. (let ((args (list bible-sword-query nil (current-buffer) t "-b" bible-hebrew-lexicon "-f" "plain" "-k" key)))
  926. (when bible-show-diatheke-exec
  927. (message "%s" args))
  928. (apply #'call-process args)
  929. (bible--process-href)
  930. (bidi-string-mark-left-to-right
  931. (bible--remove-module-name bible-hebrew-lexicon (substring (buffer-string) 7))))))
  932. (defun bible--lookup-lemma-hebrew (key)
  933. "Lookup lexical definition using Strong's number KEY.
  934. 1. Check hash table first. If entry found, return.
  935. 2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
  936. 3. Otherwise just use the Strong's number method."
  937. (or (gethash key bible-hash-hebrew)
  938. (puthash key
  939. (bible--lookup-def-hebrew key)
  940. bible-hash-hebrew)))
  941. ;; We use the shorter lexicons for text in tooltips. We also cache the
  942. ;; lex and morph strings, hoping to speed up tooltip rendering.
  943. (defun bible--lookup-lemma-short (lemma lexicon)
  944. "Look up lexical entry for LEMMA in short LEXICON.
  945. Returns a string that is intended to be displayed in a tooltip.
  946. Uses short lexicon (e.g. StrongsRealHebrew or StrongsRealGreek)."
  947. (when (string-match "[0-9]+" lemma)
  948. (let ((result
  949. ;; Get rid of unnecessary strongs codes at the beginning.
  950. (replace-regexp-in-string
  951. ".*[0-9]+ [0-9]+ " ""
  952. (bible--lex-query (concat (match-string 0 lemma)) lexicon))))
  953. ;; Remove parenthesized module name.
  954. (bible--remove-module-name lexicon result))))
  955. (defun bible--lookup-lex (lex)
  956. "Look up lexical item LEX. This is used for tooltips.
  957. Return hash table entry if present in `lex-hash' cache, else look up in
  958. database and stash in cache."
  959. (when lex
  960. (let* ((key (substring lex 7)) ; strip off "strong:" prefix.
  961. (lex-text (gethash key lex-hash)))
  962. ;; FIXME: Kludge alert! Emacs tooltips look really nice for
  963. ;; Greek terms, but Hebrew needs system tooltips because
  964. ;; of direction issues. Need to track down tooltip
  965. ;; problem. (FMG 5-Mar-2026)
  966. (setq use-system-tooltips (if (string-prefix-p "G" key) nil t))
  967. (if lex-text
  968. lex-text
  969. (setq lex-text
  970. (cond ((string-prefix-p "G" key)
  971. (bible--lookup-lemma-short key bible-greek-lexicon-short))
  972. ((string-prefix-p "H" key)
  973. (bidi-string-mark-left-to-right
  974. (bible--lookup-lemma-short key bible-hebrew-lexicon-short)))))
  975. (puthash key (string-fill (bible--cleanup-lex-text lex-text) 75) lex-hash)))))
  976. (defun bible--lookup-morph-entry (morph)
  977. "Look up entry for morphological item MORPH.
  978. Return hash table entry if present in `morph-hash' cache, else look up in
  979. database and stash in cache."
  980. (when morph
  981. (or (gethash morph morph-hash)
  982. (puthash morph
  983. (let (morph-module morph-key)
  984. (cond ((string-prefix-p "robinson:" morph)
  985. (setq morph-module "Robinson")
  986. (setq morph-key (substring morph (length "robinson:"))))
  987. ((string-prefix-p "packard:" morph)
  988. (setq morph-module "Packard")
  989. (setq morph-key (substring morph (length "packard:"))))
  990. ((string-prefix-p "oshm:" morph)
  991. (setq morph-module "OSHM")
  992. (setq morph-key (substring morph (length "oshm:")))))
  993. (bible--remove-module-name morph-module (bible--morph-query morph-key morph-module)))
  994. morph-hash))))
  995. ;; Get string for tooltip display
  996. (defun bible--show-lex-morph (_window object pos)
  997. "Get text for tooltip display for OBJECT at POS in WINDOW.
  998. Includes both lex and morph definitions if text module has
  999. both tags, otherwise just get lex definition."
  1000. (let* ((lex (get-text-property pos 'strong object))
  1001. (lex-text (bible--lookup-lex lex))
  1002. (morph (get-text-property pos 'morph object))
  1003. (morph-text (bible--lookup-morph-entry morph)))
  1004. (when lex-text
  1005. ;; This removes backslashes to prevent bogus command
  1006. ;; substitutions (that is, Emacs mistakenly filling in a key
  1007. ;; binding for some command---see Info doc on Substituting Key
  1008. ;; Bindings) in the tooltip.
  1009. ;; REVIEW: I couldn't figure out a better way to bypass command
  1010. ;; substitution in the tooltips. (FMG 5-Mar-2026)
  1011. (subst-char-in-string
  1012. ?\\
  1013. ?
  1014. (if morph-text
  1015. (concat (string-trim lex-text) "\n" (string-trim morph-text))
  1016. (string-trim lex-text))))))
  1017. ;;;; Display Bible text
  1018. (defun bible-handle-divine-name (item)
  1019. "When ITEM is divine name, display it as such."
  1020. (let ((start (point))
  1021. (strongs (dom-attr item 'savlm)))
  1022. (insert "LORD")
  1023. (let ((end (point)))
  1024. (add-face-text-property start end 'bold)
  1025. (put-text-property start end 'keymap bible-hebrew-keymap)
  1026. (when (and strongs (string-match "strong:H" strongs))
  1027. (put-text-property start end 'help-echo 'bible--show-lex-morph)
  1028. (put-text-property start end 'strong (match-string 0 strongs))))))
  1029. (defun bible--process-word (item iproperties)
  1030. "Handle <w ...> fubar </w> tag in ITEM. Check IPROPERTIES for qualifiers.
  1031. Add tooltips for definitions and morphology. Also insert lemmas in
  1032. buffer if `word study' is turned on (must be done after item is inserted
  1033. in buffer)."
  1034. (let ((word (string-trim (bible-dom-text item)))
  1035. (morph (dom-attr item 'morph))
  1036. (savlm (dom-attr item 'savlm))
  1037. (lemma (dom-attr item 'lemma))
  1038. (divinename (dom-by-tag item 'divinename)))
  1039. (let ((start (point))
  1040. (end (+ (point) (length word))))
  1041. (insert word)
  1042. ;; REVIEW: Special case this. Some modules do this differently.
  1043. ;; (FMG 5-Mar-2026)
  1044. (when divinename
  1045. (just-one-space)
  1046. (bible-handle-divine-name item)
  1047. (just-one-space))
  1048. ;; Red letter.
  1049. (when (plist-get iproperties 'jesus)
  1050. (add-face-text-property start end '(:foreground "red")))
  1051. ;; lexical definitions
  1052. ;; N.B. There are some severe issues with Strongs numbers in some modules.
  1053. (when (or savlm lemma)
  1054. (let* ((matched nil)
  1055. (lexemes (split-string (or savlm lemma)))
  1056. (lexeme
  1057. ;; HACK: Kludge alert. KJV module conflates Greek
  1058. ;; articles with nouns. Deal with this.
  1059. ;; (FMG 5-Mar-2026)
  1060. (let ((lexeme-list
  1061. (if (string= bible-text "KJV")
  1062. (reverse lexemes) ; Use the last `strong:' entry.
  1063. lexemes)))
  1064. (catch 'loop
  1065. (dolist (item lexeme-list)
  1066. (when (string-prefix-p "strong:" item)
  1067. (throw 'loop item)))))))
  1068. (when lexeme
  1069. (cond ((string-match "strong:G.*" lexeme) ; Greek
  1070. (setq matched (match-string 0 lexeme))
  1071. (put-text-property start end 'keymap bible-greek-keymap))
  1072. ((string-match "strong:H.*" lexeme) ; Hebrew
  1073. (setq matched (match-string 0 lexeme))
  1074. (put-text-property start end 'keymap bible-hebrew-keymap)))
  1075. ;; Add help-echo, strongs reference for tooltips if match.
  1076. (when matched
  1077. (setq bible-has-lexemes " Lex")
  1078. (put-text-property start end 'help-echo 'bible--show-lex-morph)
  1079. (put-text-property start end 'strong matched))))
  1080. ;; morphology
  1081. (when morph
  1082. (let* ((matched nil)
  1083. (morphemes (split-string morph))
  1084. (morpheme (car (last morphemes)))) ; KJV kludge as above
  1085. (if (or
  1086. (string-match "robinson:.*" morpheme) ; Robinson Greek morphology
  1087. (string-match "packard:.*" morpheme) ; Packard Greek morphology --- LXX seems to use this
  1088. (string-match "oshm:.*" morpheme)) ; OSHM Hebrew morphology
  1089. (setq matched (match-string 0 morpheme)))
  1090. (when matched
  1091. (setq bible-has-morphemes " Morph")
  1092. (put-text-property start end 'morph matched)
  1093. (put-text-property start end 'help-echo 'bible--show-lex-morph))))
  1094. ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
  1095. ;; TODO: Should I enable lexicon lookups on these lemmas? I
  1096. ;; don't use this anyway.... (FMG 5-Mar-2026)
  1097. (when (and bible-word-study-enabled lemma (string-match "lemma.*:.*" lemma))
  1098. (dolist (word (split-string (match-string 0 lemma) " "))
  1099. (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
  1100. (just-one-space)
  1101. (let ((refstart (point)))
  1102. (insert word)
  1103. (add-face-text-property refstart (point) '(:foreground "blue"))
  1104. (put-text-property refstart (point) 'keymap bible-lemma-keymap))))))))
  1105. (defun bible-new-line ()
  1106. "Ensure beginning of line. Try to avoid redundant blank lines."
  1107. (unless (bolp)
  1108. (newline)))
  1109. (defun bible--insert-title (title-node)
  1110. "Insert the text in TITLE-NODE into buffer as a chapter title.
  1111. Since each verse will have a `title' tag, keep track and only emit a
  1112. title when the new title in `title-node' is different from the one
  1113. stored in `bible-chapter-title'."
  1114. (unless (equal bible-chapter-title title-node)
  1115. (setq-local bible-chapter-title title-node)
  1116. (let ((title-text
  1117. (replace-regexp-in-string ; Clear out XML.
  1118. "<.*?>" ""
  1119. (bible-dom-texts bible-chapter-title)))
  1120. (start (point)))
  1121. (bible-new-line)
  1122. ;; Insert the LRM character to make the text render left-to-right.
  1123. ;; This is necessary in the KJV module when displaying psalm 119.
  1124. (insert (string ?\x200e) title-text)
  1125. (put-text-property start (point) 'face 'bold)
  1126. (newline)
  1127. (delete-blank-lines))))
  1128. ;; These tags appear in ESV modules (and maybe others?)
  1129. ;; REVIEW: Is this right? (FMG 5-Mar-2026)
  1130. (defun bible--level-tag (node)
  1131. "Indent or break line as dictated by NODE."
  1132. (let ((type (dom-attr node 'type))
  1133. (level (dom-attr node 'level)))
  1134. (cond ((and type (string-equal-ignore-case type "x-br"))
  1135. (newline))
  1136. ((and type (string-equal-ignore-case type "x-indent"))
  1137. (insert "\t"))
  1138. ;; REVIEW: Some modules use `level' tag but
  1139. ;; not in a consistent way. (FMG 7-Mar-2026)
  1140. ((equal level "1")
  1141. (just-one-space))
  1142. ((equal level "2")
  1143. (newline)
  1144. (delete-blank-lines)))))
  1145. (defun bible--insert-xref (node)
  1146. "Insert a cross reference specified by NODE."
  1147. ;; TODO: Finish handling multiple consecutive cross references. (FMG 25-Mar-2026)
  1148. ;; TODO: Fix punctuation. (FMG 25-Mar-2026)
  1149. (let* ((word (bible-dom-text node))
  1150. (refs (split-string word ";" t)))
  1151. (message "ref-word: %s" word)
  1152. (dolist (ref refs)
  1153. (message "ref %s" ref)
  1154. (just-one-space)
  1155. (let ((start (point)))
  1156. (insert ref)
  1157. (let ((end (point)))
  1158. (put-text-property start end 'xref ref)
  1159. (put-text-property start end 'keymap bible-term-mode-map)
  1160. (put-text-property start end 'help-echo (concat "Go to " ref))
  1161. (add-face-text-property start end '(:foreground "blue")))))))
  1162. (defun bible--insert-domnode-recursive (node &optional iproperties)
  1163. "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
  1164. Inserts resulting text into active buffer with properties specified in
  1165. IPROPERTIES.
  1166. In processing subnodes, each case will prepend a space if it needs it."
  1167. (when (and bible-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
  1168. ;; For red-letter display.
  1169. (setq iproperties (plist-put iproperties 'jesus t)))
  1170. (dolist (subnode (dom-children node))
  1171. (cond ((null subnode) nil)
  1172. ((stringp subnode)
  1173. ;; Red letter
  1174. (when (plist-get iproperties 'jesus)
  1175. (add-face-text-property 0 (length subnode) '(:foreground "red") nil subnode))
  1176. (insert subnode))
  1177. ((consp subnode)
  1178. (let ((tag (dom-tag subnode)))
  1179. (pcase tag
  1180. ;; TODO: There are lots of tags we don't handle, especially in commentaries.
  1181. ;; Maybe process these at some point? Include footnotes etc.
  1182. ;; (FMG 5-Mar-2026)
  1183. ;; ('node nil)
  1184. ;; 'w is usual case.
  1185. ('w (insert " ") (bible--process-word subnode iproperties))
  1186. ('title
  1187. ;; This mess is to deal with the possibility that the
  1188. ;; title might change in the middle of the chapter. I'm
  1189. ;; talking about YOU, Psalm 119.
  1190. (if bible-chapter-title
  1191. (bible--insert-title subnode) ; Middle of chapter.
  1192. (save-excursion
  1193. (goto-char (point-min))
  1194. (bible--insert-title subnode)))) ; Beginning of chapter.
  1195. ;; Font tag should be ignored, treat as if 'w
  1196. ('font (insert " ") (bible--process-word subnode iproperties))
  1197. ('hi (when (equal (dom-attr subnode 'type) "bold")
  1198. (just-one-space)
  1199. (let ((word (bible-dom-text subnode))
  1200. (start (point)))
  1201. (insert word)
  1202. (put-text-property start (point) 'face 'bold))))
  1203. ('i ; Italic face (special case for certain module)
  1204. (just-one-space)
  1205. (let ((word (bible-dom-text subnode))
  1206. (start (point)))
  1207. (insert word)
  1208. (put-text-property start (point) 'face 'bold)
  1209. (add-face-text-property start (point) '(:foreground "orange"))))
  1210. ;; 'q is used for red letter.
  1211. ;; NASB Module uses 'seg to indicate OT quotations (and others?).
  1212. ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties))
  1213. ('l (bible--level-tag subnode))
  1214. ;; REVIEW: divine name handling doesn't seem to work the same
  1215. ;; with all modules.
  1216. ('divinename (bible-handle-divine-name subnode))
  1217. ;; Some modules use this for line breaks and such.
  1218. ('milestone
  1219. (pcase (dom-attr subnode 'type)
  1220. ("line" (bible-new-line))
  1221. ;; ("x-PN" (bible-new-line))
  1222. ("x-p" (insert (dom-attr subnode 'marker) " "))))
  1223. ('br (bible-new-line))
  1224. ('lb (when (equal (dom-attr subnode 'type) "x-begin-paragraph") (bible-new-line)))
  1225. ('div (when (or (equal (dom-attr subnode 'type) "paragraph")
  1226. (equal (dom-attr subnode 'type) "x-p"))
  1227. (bible-new-line)))
  1228. ;; For commentaries and the like.
  1229. ;; TODO: Clicking on verse doesn't work yet. This will take work. (FMG 5-Mar-2026)
  1230. ((or 'scripref 'reference) (bible--insert-xref subnode))
  1231. ;; Various text properties---ignore for now
  1232. ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
  1233. ;; Word inserted by translation, not in original, give visual indication.
  1234. ('transchange
  1235. (insert " ")
  1236. (let ((word (bible-dom-text subnode))
  1237. (start (point))
  1238. (face (if (plist-get iproperties 'jesus) '(:foreground "salmon") '(:foreground "gray50"))))
  1239. (insert word)
  1240. (add-face-text-property start (point) face)))))))))
  1241. (defun bible--display (&optional _module verse)
  1242. "Render a page (chapter) of a Bible module.
  1243. Defaults to using `bible-text'.
  1244. If optional argument MODULE is supplied, use that module for display.
  1245. If optional argument VERSE is supplied, set cursor at verse."
  1246. ;; (when module (setq-local bible-text module))
  1247. (let ((buffer-read-only nil)
  1248. (bible-has-lexemes nil)
  1249. (bible-has-morphemes nil))
  1250. (erase-buffer)
  1251. (insert (bible--exec-diatheke (concat bible--current-book-name ":" (number-to-string bible--current-chapter))))
  1252. ;; Parse the xml in the buffer into a DOM tree.
  1253. (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
  1254. ;; Render the DOM tree into the buffer.
  1255. (unless bible-debugme ; If this is true, display the XML.
  1256. (erase-buffer)
  1257. (setq-local bible-chapter-title nil)
  1258. ;; Looking for the "body" tag in the DOM node.
  1259. (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body))
  1260. (goto-char (point-min))))
  1261. (save-excursion
  1262. (let ((search-string (concat " *" (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
  1263. ;; Delete <Book Ch:> at beginning of verse, just leave verse number.
  1264. (while (re-search-forward search-string nil t)
  1265. (replace-match "")
  1266. (bible-new-line)
  1267. ;; Highlight verse number
  1268. ;; (when (re-search-forward "^ *[0-9]+" nil t 1)
  1269. (when (re-search-forward " *[0-9]+:" nil t 1)
  1270. (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
  1271. (save-excursion
  1272. ;; Fix divine name lossage.
  1273. (while (re-search-forward "Lord LORD" nil t)
  1274. (replace-match "LORD")
  1275. (add-face-text-property (point) (- (point) 4) 'bold))
  1276. (while (re-search-forward "Lord.+s LORD" nil t -1)
  1277. (replace-match "LORD's")
  1278. (add-face-text-property (1- (point)) (- (point) 5) 'bold))
  1279. ;; Remove the module name from the buffer.
  1280. (while (re-search-forward (concat "^.*" bible-text ".*$") nil t)
  1281. (replace-match "" nil t)))
  1282. (save-excursion
  1283. (format-replace-strings '(("." . ". ")
  1284. ("," . ", ")
  1285. (";" . "; ")
  1286. (":" . ": ")
  1287. ("?" . "? ")
  1288. ("!" . "! ")
  1289. (" ." . ". ")
  1290. (" ," . ", ")
  1291. (" ;" . "; ")
  1292. (" :" . ": ")
  1293. (" ?" . "? ")
  1294. (" !" . "! ")
  1295. ("“ " . "“")
  1296. ("‘ " . "‘")
  1297. (" ’" . "’")
  1298. (". ”" . ".”")
  1299. ("? ”" . "?”"))
  1300. nil (point-min) (point-max)))
  1301. ;; Get rid of multiple consecutive spaces.
  1302. (save-excursion
  1303. (while (re-search-forward " *" nil t) ; More than one space in a row
  1304. ;; (replace-match " ")))
  1305. (just-one-space)))
  1306. ;; Set the mode line of the biffer.
  1307. (if bible-has-lexemes
  1308. (unless (string-match " Lex" mode-name) (setq mode-name (concat mode-name " Lex")))
  1309. (setq mode-name (replace-regexp-in-string " Lex" "" mode-name)))
  1310. (if bible-has-morphemes
  1311. (unless (string-match " Morph" mode-name) (setq mode-name (concat mode-name " Morph")))
  1312. (setq mode-name (replace-regexp-in-string " Morph" "" mode-name)))
  1313. ;; (setq mode-name (concat mode-name (when bible-has-lexemes " Lex") (when bible-has-morphemes " Morph")))
  1314. (force-mode-line-update))
  1315. ;; If optional verse specification go to that verse.
  1316. (when verse
  1317. (re-search-forward (concat " ?" (number-to-string verse)) nil t)))
  1318. ;;;; Modules (Bible texts, commentaries)
  1319. (defun compare-module-names (n1 n2)
  1320. "Compare N1 and N2, ignoring case, using collation order."
  1321. (string-collate-lessp n1 n2 nil t))
  1322. (defun bible--get-biblical-modules ()
  1323. "Populate `bible--texts' and `bible--commentaries' lists."
  1324. (let ((lines
  1325. (split-string
  1326. (bible--exec-diatheke "modulelist" nil "plain" "system")
  1327. "[\n\r]+"))
  1328. (texts nil)
  1329. (commentaries nil)
  1330. (doing-texts nil)
  1331. (doing-commentaries nil))
  1332. (setq bible--texts nil)
  1333. (setq bible--commentaries nil)
  1334. (catch 'done
  1335. (dolist (line lines)
  1336. (when doing-texts
  1337. (push (split-string line " : ") texts))
  1338. (when doing-commentaries
  1339. (push (split-string line " : ") commentaries))
  1340. (when (string-equal line "Biblical Texts:")
  1341. (setq doing-texts t))
  1342. (when (string-equal line "Commentaries:")
  1343. (setq doing-texts nil)
  1344. (pop texts) ; Remove `Commentaries:' line from `bible--texts'.
  1345. (setq doing-commentaries t))
  1346. (when (string-equal line "Lexicons / Dictionaries:")
  1347. (pop commentaries) ; Remove `Lexicons / Dictionaries:' line
  1348. ; from bible--commentaries.
  1349. (throw 'done nil))))
  1350. (setq bible--texts (cl-sort texts #'compare-module-names :key #'car))
  1351. (setq bible--commentaries (cl-sort commentaries #'compare-module-names :key #'car)))
  1352. nil)
  1353. (defun bible--list-biblical-texts ()
  1354. "Return a list of accessible Biblical Text modules."
  1355. (bible--get-biblical-modules) ; Make sure the lists are fresh.
  1356. bible--texts)
  1357. (defun bible--list-biblical-commentaries ()
  1358. "Return a list of accessible Biblical Text modules."
  1359. (bible--get-biblical-modules) ; Make sure the lists are fresh.
  1360. bible--commentaries)
  1361. (defconst bible-text-map (make-keymap))
  1362. (define-key bible-text-map [mouse-1] 'bible-pick-module)
  1363. (define-key bible-text-map (kbd "RET") 'bible-pick-module)
  1364. (defun bible-display-available-texts ()
  1365. "Display available modules, allow user to select."
  1366. (interactive)
  1367. (bible--get-biblical-modules) ; Make sure lists are fresh.
  1368. (with-current-buffer (get-buffer-create "Texts")
  1369. (bible-text-select-mode)
  1370. (let ((buffer-read-only nil))
  1371. (erase-buffer)
  1372. (setq-local tab-stop-list '(25))
  1373. (dolist (text bible--texts)
  1374. (let ((name (string-trim (car text)))
  1375. (description (string-trim-left (cadr text))))
  1376. (insert
  1377. (propertize (string-trim name)
  1378. 'face 'bold
  1379. 'module name
  1380. 'help-echo (concat "Select " name)
  1381. 'keymap bible-text-map))
  1382. (move-to-tab-stop)
  1383. (insert (format "%s\n" description)))))
  1384. (goto-char (point-min))
  1385. (pop-to-buffer (current-buffer) nil t)))
  1386. (defun bible-display-available-commentaries ()
  1387. "Display available modules, allow user to select."
  1388. (interactive)
  1389. (bible--get-biblical-modules) ; Make sure lists are fresh.
  1390. (with-current-buffer (get-buffer-create "Commentaries")
  1391. (bible-text-select-mode)
  1392. (let ((buffer-read-only nil))
  1393. (erase-buffer)
  1394. (setq-local tab-stop-list '(25))
  1395. (dolist (commentary bible--commentaries)
  1396. (let ((name (string-trim (car commentary)))
  1397. (description (string-trim-left (cadr commentary))))
  1398. (insert
  1399. (propertize (string-trim name)
  1400. 'face 'bold
  1401. 'module name
  1402. 'help-echo (concat "Select " name)
  1403. 'keymap bible-text-map))
  1404. (move-to-tab-stop)
  1405. (insert (format "%s\n" description)))))
  1406. (goto-char (point-min))
  1407. (pop-to-buffer (current-buffer) nil t)))
  1408. ;;;; Bible Searching
  1409. (defvar-local bible-search-word "")
  1410. (defvar-local bible-search-module "")
  1411. (defvar-local bible-search-matches 0)
  1412. (defun bible--open-search (query searchmode module)
  1413. "Open a search buffer of QUERY using SEARCHMODE in module MODULE."
  1414. (let ((results (string-trim (replace-regexp-in-string
  1415. "Entries .+?--" ""
  1416. (bible--diatheke-search query searchmode "plain" module)))))
  1417. (if (equal results (concat "none (" module ")"))
  1418. (message (concat
  1419. "No results found."
  1420. (when (equal searchmode "lucene")
  1421. " Verify index has been build with mkfastmod.")))
  1422. (with-current-buffer (get-buffer-create (concat "*bible-search*"))
  1423. (bible-search-mode)
  1424. (bible--display-search results module)
  1425. (setq-local bible-search-word query
  1426. bible-search-module module)
  1427. (pop-to-buffer (current-buffer) nil t)))))
  1428. (defun bible--display-search (results module)
  1429. "Render RESULTS of search query with MODULE."
  1430. (let ((match 0)
  1431. (matchstr "")
  1432. (verses nil)
  1433. (query-verses "")
  1434. (buffer-read-only nil))
  1435. ;; (message "display-search %s" module)
  1436. (setq-local mode-line-format bible-search-mode-line-format)
  1437. (setq-default bible-text module)
  1438. (erase-buffer)
  1439. (while match
  1440. (setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
  1441. matchstr (match-string 0 results))
  1442. (when match
  1443. (push
  1444. ;; Massage match to make it more sortable, get rid of some characters.
  1445. (replace-regexp-in-string
  1446. ".+; " ""
  1447. (string-replace
  1448. "I " "1"
  1449. (string-replace
  1450. "II " "2"
  1451. (string-replace
  1452. "III " "3"
  1453. matchstr))))
  1454. verses)))
  1455. (setq verses (cl-sort verses #'string-version-lessp))
  1456. (dolist (verse verses)
  1457. (if query-verses
  1458. (setq query-verses (concat query-verses ";" verse))
  1459. (setq query-verses verse)))
  1460. (let ((bible-show-diatheke-exec nil))
  1461. (insert (bible--exec-diatheke query-verses nil nil module)))
  1462. (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
  1463. (erase-buffer)
  1464. (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body)))
  1465. (goto-char (point-min))
  1466. ;; Remove module name from buffer.
  1467. (save-excursion
  1468. (while (re-search-forward (concat "^.*" module ".*$") nil t)
  1469. (replace-match "")))
  1470. (setq mode-name "Bible Search ")
  1471. (when bible-search-range
  1472. (setq mode-name (concat mode-name " <" bible-search-range ">")))
  1473. (setq-local bible-search-matches (length verses))))
  1474. ;;;; Terms (lemmas, morphemes)
  1475. ;;(defun bible-display-morphology (morph)
  1476. ;; ;; REVIEW: Do something here? (FMG 5-Mar-2026)
  1477. ;; )
  1478. (defun bible--fixup-lexicon-display (_termtype)
  1479. "Fixup the display of a lexical entry whose language is given by TERMTYPE."
  1480. (let ((buffer-read-only nil))
  1481. (goto-char (point-min))
  1482. ;;; (save-excursion
  1483. ;;; ;; This enables clicking on Strong's numbers in some lexicon definitions.
  1484. ;;; (while (search-forward-regexp "[0-9]+" nil t)
  1485. ;;; (let ((match (match-string 0))
  1486. ;;; (start (match-beginning 0))
  1487. ;;; (end (match-end 0)))
  1488. ;;; (cond ((eq termtype 'hebrew)
  1489. ;;; (put-text-property start end 'strong (concat "strong:H" match))
  1490. ;;; (put-text-property start end 'keymap bible-hebrew-keymap)
  1491. ;;; (add-face-text-property start end `(:foreground "blue")))
  1492. ;;; ((eq termtype 'greek)
  1493. ;;; (put-text-property start end 'strong (concat "strong:G" match))
  1494. ;;; (put-text-property start end 'keymap bible-greek-keymap)
  1495. ;;; (add-face-text-property start end `(:foreground "blue")))))))
  1496. ;; This enables clicking on verse references.
  1497. ;; REVIEW: this should be conflated with bible--insert-xref above. (FMG 25-Mar-2026)
  1498. (save-excursion
  1499. (while (search-forward-regexp bible--verse-regexp nil t)
  1500. (let ((match (match-string 0))
  1501. (start (match-beginning 0))
  1502. (end (match-end 0)))
  1503. (put-text-property start end 'xref match)
  1504. (put-text-property start end 'keymap bible-search-mode-map)
  1505. (put-text-property start end 'help-echo (concat "Go to " (substring-no-properties match)))
  1506. (add-face-text-property start end '(:foreground "blue")))))
  1507. (save-excursion
  1508. (while (search-forward "()" nil t)
  1509. (replace-match "")))))
  1510. (defun bible--open-term-hebrew (term)
  1511. "Open a buffer of the Strong's Hebrew TERM's definition."
  1512. (with-current-buffer (get-buffer-create (concat "*bible-term-hebrew-" term "*"))
  1513. (bible-term-hebrew-mode)
  1514. (setq-local bidi-paragraph-direction 'left-to-right)
  1515. (bible--display-lemma-hebrew term)
  1516. (pop-to-buffer (current-buffer) nil t)
  1517. (fit-window-to-buffer)))
  1518. (defun bible--display-lemma-hebrew (lemma)
  1519. "Render the definition of the Strong's Hebrew LEMMA.
  1520. This code is customized for the BDBGlosses_Strongs lexicon."
  1521. (let ((buffer-read-only nil))
  1522. (erase-buffer)
  1523. ;; BDBGlosses_Strongs needs the prefixed `H'.
  1524. (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew (concat "H" lemma))) 7))
  1525. ;; (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew lemma)) 7))
  1526. (bible--fixup-lexicon-display 'hebrew)))
  1527. (defun bible--open-term-greek (term)
  1528. "Open a buffer of the Strong's Greek TERM definition."
  1529. (with-current-buffer (get-buffer-create (concat "*bible-term-greek-" term "*"))
  1530. (bible-term-greek-mode)
  1531. (bible--display-lemma-greek term)
  1532. (pop-to-buffer (current-buffer) nil t)
  1533. (fit-window-to-buffer)))
  1534. (defun bible--display-lemma-greek (lemma)
  1535. "Render the definition of the Strong's Greek LEMMA."
  1536. (let ((buffer-read-only nil))
  1537. (erase-buffer)
  1538. (insert (bible--lookup-lemma-greek lemma))
  1539. (bible--fixup-lexicon-display 'greek)))
  1540. (defun bible--do-set-location (book chapter &optional verse)
  1541. (setq-local bible--current-book book)
  1542. (setq-local bible--current-book-name (car book))
  1543. (setq-local bible--current-chapter chapter)
  1544. (bible--display bible-text verse))
  1545. (defun bible--set-location (book chapter &optional verse)
  1546. "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
  1547. (let ((buffer (current-buffer)))
  1548. (bible--do-set-location book chapter verse)
  1549. (when (cl-find buffer bible--synced-buffers)
  1550. (save-excursion
  1551. (dolist (buf bible--synced-buffers)
  1552. (unless (eq buf buffer)
  1553. (with-current-buffer buf
  1554. (bible--do-set-location book chapter verse))))))))
  1555. ;;;; Utilities
  1556. (defun bible--remove-module-name (module-name string)
  1557. "Remove parenthesized MODULE-NAME from STRING.
  1558. Also deals with bug where some versions of diatheke return string that
  1559. is missing close parenthesis."
  1560. (replace-regexp-in-string (concat "^(" module-name ".*$") "" string))
  1561. (defun bible--list-number-range (min max &optional prefix)
  1562. "Returns a list containing entries for each integer between MIN and MAX.
  1563. If PREFIX is supplied, prepend PREFIX to the entries.
  1564. Used in tandem with `completing-read' for chapter selection."
  1565. (let ((range-list nil))
  1566. (dotimes (num (1+ max))
  1567. (when (>= num min)
  1568. (push (cons (concat prefix (number-to-string num)) num) range-list)))
  1569. (nreverse range-list)))
  1570. ;;; Provides
  1571. (provide 'bible)
  1572. ;;; bible.el ends here.