bible-mode.el 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468
  1. ;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
  2. ;;
  3. ;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI
  4. ;; Author: Zacalot
  5. ;; Substantial fixes and modifications by Fred Gilham
  6. ;; Url: https://gitbot.homedns.org/fred/bible-mode
  7. ;; Forked from
  8. ;; Url: https://github.com/Zacalot/bible-mode
  9. ;; Version: 1.0.0
  10. ;; Package-Requires: ((emacs "24.1"))
  11. ;; Keywords: diatheke, sword, research, bible
  12. ;;; Commentary:
  13. ;; This package uses the `diatheke' program to browse and search
  14. ;; Biblical texts provided by the Sword project.
  15. ;; Word study is also supported.
  16. ;;; Usage:
  17. ;; First install `diatheke'. On Debian/Ubuntu it's in the `diatheke'
  18. ;; package. In other distributions it might be in the sword package.
  19. ;; For Windows I found that you can simply install the Xiphos package.
  20. ;; It includes the Sword library and its utilities including diatheke,
  21. ;; installmgr and mkfastmod. Add the "Program Files\Xiphos\bin" path
  22. ;; to your execution path.
  23. ;; Use M-x `bible-open' to open a Bible buffer.
  24. ;; Use C-h f `bible-mode' to see available keybindings.
  25. ;; You may customize `bible-mode-module' to set a default browsing
  26. ;; module, as well as `bible-mode-word-study-enabled' to enable word
  27. ;; study by default.
  28. ;;; Design:
  29. ;; The idea here is to use the diatheke program to insert code from
  30. ;; modules into buffers. The main bible display uses an "internal" XML
  31. ;; format. The whole buffer gets parsed by libxml-parse-html-region to
  32. ;; create a dom tree. This gets parsed by
  33. ;; bible-mode--insert-domnode-recursive to render the text into
  34. ;; reading format.
  35. ;; The text is then decorated using information from the dom format as
  36. ;; necessary along with regular expressions to identify the verse
  37. ;; references. This is for red letters, purple highlighting of the
  38. ;; verse numbers, bold face of the divine name in the OT and so on.
  39. ;; If strongs tags and/or morphological tags are present, they are
  40. ;; looked up in appropriate lexical and morphological modules and used
  41. ;; to add tooltips to the text so that mousing over words will bring
  42. ;; up a tooltip with information about the word. Clicking on a word
  43. ;; with lexical information will display that informatio in a "term"
  44. ;; buffer.
  45. ;;; Code:
  46. ;;;; Requirements
  47. ;;; XXX FMG there are just a few constructs that use this; use elisp versions instead.
  48. ;;(require 'cl-lib)
  49. (require 'dom)
  50. (require 'shr)
  51. ;; Turn off tool bar mode because we want the pixels....
  52. (tool-bar-mode -1)
  53. ;;;; Variables
  54. (defgroup bible-mode nil
  55. "Settings for `bible-mode'."
  56. :group 'tools
  57. :link '(url-link "https://gitbot.homedns.org/fred/bible-mode"))
  58. (defcustom bible-mode-module
  59. "KJV"
  60. "Book module for Diatheke to query."
  61. :type '(choice (const :tag "None" nil)
  62. (string :tag "Module abbreviation (e.g. \"KJV\")"))
  63. ;; :local t
  64. :group 'bible-mode)
  65. ;;;
  66. ;;; XXX Not implememted yet
  67. (defcustom bible-mode-font
  68. "Ezra SIL"
  69. "Default font for bible-mode."
  70. :type '(string :tag "Font family name (e.g. \"Ezra SIL\")")
  71. :local t
  72. :group 'bible-mode)
  73. (defcustom bible-mode-greek-lexicon
  74. "AbbottSmithStrongs"
  75. "Lexicon used for displaying definitions of Greek words using Strong's codes."
  76. :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
  77. :local nil
  78. :group 'bible-mode)
  79. (defcustom bible-mode-use-index-for-lexicon nil
  80. "Some lexicons are accessed by lemmas rather than Strong's numbers.
  81. Use an index to look up lemmas from Strong's numbers so these lexicons can
  82. be used. Examples of this type of lexicon are AbbottSmith and
  83. LiddellScott. XXX LiddellScott currently doesn't work. XXX AbbottSmithStrongs
  84. now has the complete entries instead of just links."
  85. :type 'boolean
  86. :local nil
  87. :group 'bible-mode)
  88. (defcustom bible-mode-lexicon-index "AbbottSmithStrongs"
  89. "A module that consists of an index mapping Strong's numbers to Greek lemmas.
  90. The code is written to use the entries in AbbottSmithStrongs
  91. which are of the form
  92. <strong's number>: @LINK <greek lemma>"
  93. :type '(string :tag "Lexicon index.")
  94. :local nil
  95. :group 'bible-mode)
  96. (defcustom bible-mode-greek-lexicon-short
  97. "StrongsRealGreek"
  98. "Lexicon used for displaying definitions of Greek words in tooltips."
  99. :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
  100. :local nil
  101. :group 'bible-mode)
  102. (defcustom bible-mode-hebrew-lexicon
  103. "StrongsRealHebrew"
  104. "Lexicon used for displaying definitions of Hebrew words using Strong's codes."
  105. :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
  106. :local nil
  107. :group 'bible-mode)
  108. (defcustom bible-mode-hebrew-lexicon-short
  109. "BDBGlosses_Strongs" ; This seems to work
  110. "Lexicon used for displaying definitions of Hebrew words in tooltips."
  111. :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
  112. :local nil
  113. :group 'bible-mode)
  114. (defcustom bible-mode-word-study-enabled
  115. nil
  116. "Display Strong's Hebrew, Strong's Greek, and Lemma words for study."
  117. :type 'boolean
  118. :local t
  119. :group 'bible-mode)
  120. (defcustom bible-mode-red-letter-enabled
  121. t
  122. "Display words of Jesus in red when module has that information."
  123. :type 'boolean
  124. :local t
  125. :group 'bible-mode)
  126. (defcustom bible-mode-show-diatheke-exec
  127. t
  128. "Show the arguments by which diatheke is executed."
  129. :type 'boolean
  130. :local nil
  131. :group 'bible-mod)
  132. ;;; variable defs
  133. ;;(defvar bible-mode-verse-regexp "([\d ]*[a-zA-Z]+( \d*:\d*)?)(( - )| )?(((\d* )?[a-zA-Z]+ )?\d*([:-]+\d*)?)")
  134. ;; (defvar bible-mode-verse-regexp "/(\d*)\s*([a-z]+)\s*(\d+)(?::(\d+))?(\s*-\s*(\d+)(?:\s*([a-z]+)\s*(\d+))?(?::(\d+))?)?/i")
  135. (defconst bible-mode-verse-regexp "\\(I \\|II \\|III \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
  136. (defvar bible-mode-modules (lazy-completion-table bible-mode-modules bible-mode--list-biblical-modules))
  137. ;; XXX I believe these chapter counts aren't the same for all modules, e.g. JPS.
  138. (defvar bible-mode-books
  139. '(;; Old Testament
  140. ("Genesis" . 50) ("Exodus" . 40) ("Leviticus" . 27) ("Numbers" . 36)
  141. ("Deuteronomy" . 34) ("Joshua" . 24) ("Judges" . 21) ("Ruth" . 4)
  142. ("I Samuel" . 31) ("II Samuel" . 24) ("I Kings" . 22) ("II Kings" . 25)
  143. ("I Chronicles" . 29) ("II Chronicles" . 36) ("Ezra" . 10) ("Nehemiah" . 13)
  144. ("Esther" . 10) ("Job" . 42) ("Psalms" . 150) ("Proverbs" . 31)
  145. ("Ecclesiastes" . 12) ("Song of Solomon" . 8) ("Isaiah" . 66) ("Jeremiah" . 52)
  146. ("Lamentations" . 5) ("Ezekiel" . 48) ("Daniel" . 12) ("Hosea" . 14)
  147. ("Joel" . 3) ("Amos" . 9) ("Obadiah" . 1) ("Jonah" . 4)
  148. ("Micah" . 7) ("Nahum" . 3) ("Habakkuk" . 3) ("Zephaniah" . 3)
  149. ("Haggai" . 2) ("Zechariah" . 14) ("Malachi" . 4)
  150. ;; New Testament
  151. ("Matthew" . 28) ("Mark" . 16) ("Luke" . 24) ("John" . 21)
  152. ("Acts" . 28) ("Romans" . 16) ("I Corinthians" . 16) ("II Corinthians" . 13)
  153. ("Galatians" . 6) ("Ephesians" . 6) ("Philippians" . 4) ("Colossians" . 4)
  154. ("I Thessalonians" . 5) ("II Thessalonians" . 3) ("I Timothy" . 6) ("II Timothy" . 4)
  155. ("Titus" . 3) ("Philemon" . 1) ("Hebrews" . 13) ("James" . 5)
  156. ("I Peter" . 5) ("II Peter" . 3) ("I John" . 5) ("II John" . 1)
  157. ("III John" . 1) ("Jude" . 1) ("Revelation of John" . 22))
  158. "A-list of name / chapter count for Bible books.")
  159. (defvar bible-mode-book-name-abbreviations-alist
  160. '(;; Old Testament
  161. ("Ge" . "Genesis") ("Ex" . "Exodus") ("Le" . "Leviticus") ("Nu" . "Numbers")
  162. ("De" . "Deuteronomy") ("Js" . "Joshua") ("Jg" . "Judges") ("Ru" . "Ruth")
  163. ("I Sa" . "I Samuel") ("II Sa" . "II Samuel") ("I Ki" . "I Kings") ("II Ki" . "II Kings")
  164. ("I Ch" . "I Chronicles") ("II Ch" . "II Chronicles") ("Ezr" . "Ezra") ("Ne" . "Nehemiah")
  165. ("Es" . "Esther") ("Jb" . "Job") ("Ps" . "Psalms") ("Pr" . "Proverbs")
  166. ("Ec" . "Ecclesiastes") ("So" . "Song of Solomon") ("Is" . "Isaiah") ("Je" . "Jeremiah")
  167. ("La" . "Lamentations") ("Ez" . "Ezekiel") ("Da" . "Daniel") ("Ho" . "Hosea")
  168. ("Joe" . "Joel") ("Am" . "Amos") ("Ob" . "Obadiah") ("Jon" . "Jonah")
  169. ("Mi" . "Micah") ("Na" . "Nahum") ("Ha" . "Habakkuk") ("Zep" . "Zephaniah")
  170. ("Hag" . "Haggai") ("Ze" . "Zechariah") ("Mal" . "Malachi")
  171. ;; New Testament
  172. ("Mt" . "Matthew") ("Mk" . "Mark") ("Lk" . "Luke") ("Jo" . "John")
  173. ("Ac" . "Acts") ("Ro" . "Romans") ("I Co" . "I Corinthians") ("II Co" . "II Corinthians")
  174. ("Ga" . "Galatians") ("Eph" . "Ephesians") ("Phl" . "Philippians") ("Col" . "Colossians")
  175. ("I Th" . "I Thessalonians") ("II Th" . "II Thessalonians") ("I Ti" . "I Timothy") ("II Ti" . "II Timothy")
  176. ("Tit" . "Titus") ("Phm" . "Philemon") ("He" . "Hebrews") ("Ja" . "James")
  177. ("I Pe" . "I Peter") ("II Pe" . "II Peter") ("I Jo" . "I John") ("II Jo" . "II John")
  178. ("III Jo" . "III John") ("Ju" . "Jude") ("Re" . "Revelation of John"))
  179. "A-list of abbreviations for Bible books.")
  180. ;;;; Book / chapter
  181. (defvar-local bible-mode-current-book (assoc "Genesis" bible-mode-books)
  182. "Current book data (name . chapter).")
  183. (defvar-local bible-mode-current-book-name "Genesis"
  184. "Current book name.")
  185. (defvar-local bible-mode-current-chapter 1
  186. "Current book chapter number.")
  187. (defvar-local bible-mode-query nil
  188. "Search query associated with the buffer.")
  189. (defvar-local bible-mode-search-mode "phrase"
  190. "Search mode: either `lucene', `phrase', `regex' or `multiword'.")
  191. (defvar bible-mode-search-range nil)
  192. (defvar-local bible-mode-has-strongs nil
  193. "Set if the module being displayed has strongs numbers availabile.")
  194. (defvar-local bible-mode-has-morphology nil
  195. "Set if the module being displayed has morphology availabile.")
  196. ;; (defvar bible-mode-current-module nil)
  197. ;;;; Keymaps
  198. ;;;; N.B. Bible Mode menu items appear in reverse order of their
  199. ;;;; definition below
  200. (defconst bible-mode-map (make-sparse-keymap)
  201. "Keymap for bible-mode.")
  202. (define-key bible-mode-map [menu-bar bible-mode]
  203. (cons "Bible Mode" (make-sparse-keymap "Bible Mode")))
  204. (define-key bible-mode-map
  205. [menu-bar bible-mode toggle-debug]
  206. '("Toggle debug-on-error" . toggle-debug-on-error))
  207. (defun bible-mode-toggle-display-diatheke ()
  208. "Toggle diatheke args display."
  209. (interactive)
  210. (setq bible-mode-show-diatheke-exec (not bible-mode-show-diatheke-exec)))
  211. (define-key bible-mode-map
  212. [menu-bar bible-mode display-diatheke]
  213. '("Toggle diatheke display" . bible-mode-toggle-display-diatheke))
  214. (defun bible-mode-toggle-display-xml ()
  215. "Toggle XML display."
  216. (interactive)
  217. (setq-local bible-mode-debugme (not bible-mode-debugme))
  218. (bible-mode--display))
  219. (define-key bible-mode-map "d" 'bible-mode-toggle-display-xml)
  220. (define-key bible-mode-map
  221. [menu-bar bible-mode display-xml]
  222. '("Toggle XML Display" . bible-mode-toggle-display-xml))
  223. (define-key bible-mode-map
  224. [menu-bar bible-mode sep]
  225. '(menu-item '"--"))
  226. ;;;;; Misc
  227. (define-key bible-mode-map "m" 'bible-mode-select-module)
  228. (define-key bible-mode-map "w" 'bible-mode-toggle-word-study)
  229. (define-key bible-mode-map "l" 'bible-mode-toggle-red-letter)
  230. (define-key bible-mode-map "x" 'bible-mode-split-display)
  231. (define-key bible-mode-map
  232. [menu-bar bible-mode split-display]
  233. '("Split Display" . bible-mode-split-display))
  234. ;;;;; Search
  235. (define-key bible-mode-map "/" 'bible-search)
  236. (define-key bible-mode-map "s" 'bible-search)
  237. (define-key bible-mode-map
  238. [menu-bar bible-mode search]
  239. '("Search" . bible-search))
  240. (define-key bible-mode-map "r" 'bible-mode-set-search-range)
  241. (define-key bible-mode-map
  242. [menu-bar bible-mode range]
  243. '("Set Search Range" . bible-mode-set-search-range))
  244. ;;;;; Navigation
  245. (define-key bible-mode-map "p" 'bible-mode-previous-chapter)
  246. (define-key bible-mode-map
  247. [menu-bar bible-mode previous-chapter]
  248. '("Previous Chapter" . bible-mode-previous-chapter))
  249. (define-key bible-mode-map "n" 'bible-mode-next-chapter)
  250. (define-key bible-mode-map
  251. [menu-bar bible-mode next-chapter]
  252. '("Next Chapter" . bible-mode-next-chapter))
  253. (define-key bible-mode-map (kbd "TAB") 'bible-mode-next-word)
  254. (define-key bible-mode-map (kbd "M-<tab>") 'bible-mode-previous-word)
  255. ;;;;; Direct jump
  256. (define-key bible-mode-map "c" 'bible-mode-select-chapter)
  257. (define-key bible-mode-map
  258. [menu-bar bible-mode select-chapter]
  259. '("Select Chapter" . bible-mode-select-chapter))
  260. (define-key bible-mode-map "b" 'bible-mode-select-book)
  261. (define-key bible-mode-map
  262. [menu-bar bible-mode select-book]
  263. '("Select Book" . bible-mode-select-book))
  264. (define-key bible-mode-map
  265. [menu-bar bible-mode sep]
  266. '(menu-item '"--"))
  267. ;;;;; Deal with visual-line-mode
  268. (define-key bible-mode-map "\C-n" 'next-logical-line)
  269. (define-key bible-mode-map "\C-p" 'previous-logical-line)
  270. (defun bible-mode-next-search-item ()
  271. (interactive)
  272. (search-forward-regexp bible-mode-verse-regexp))
  273. (defun bible-mode-previous-search-item ()
  274. (interactive)
  275. (search-backward-regexp bible-mode-verse-regexp))
  276. (defconst bible-search-mode-map (make-keymap))
  277. (define-key bible-search-mode-map "s" 'bible-search)
  278. (define-key bible-search-mode-map "w" 'bible-mode-toggle-word-study)
  279. (define-key bible-search-mode-map "n" 'bible-mode-next-search-item)
  280. (define-key bible-search-mode-map "p" 'bible-mode-previous-search-item)
  281. (define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
  282. (defconst bible-term-hebrew-mode-map (make-sparse-keymap))
  283. (defconst bible-term-greek-mode-map (make-sparse-keymap))
  284. (define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)
  285. ;;;
  286. ;;; Menu bar items
  287. ;;;
  288. (defvar-local bible-mode-text-direction 'left-to-right)
  289. (defun bible-mode-toggle-text-direction ()
  290. (interactive)
  291. (if (eq bible-mode-text-direction 'left-to-right)
  292. (setq-local bible-mode-text-direction 'right-to-left)
  293. (setq-local bible-mode-text-direction 'left-to-right))
  294. (setq-local bidi-paragraph-direction bible-mode-text-direction))
  295. (defvar-local bible-mode-debugme nil
  296. "Make text show up as XML when set.")
  297. (defvar use-tooltips t)
  298. (defun bible-mode-toggle-tooltips ()
  299. "Toggle use of tooltips to display lexical/morphological items."
  300. (interactive)
  301. (setq use-tooltips (not use-tooltips))
  302. (tooltip-mode 'toggle)
  303. (setq tooltip-resize-echo-area use-tooltips))
  304. (define-key bible-mode-map
  305. [menu-bar bible-mode sepp]
  306. '(menu-item '"--"))
  307. (define-key bible-mode-map
  308. [menu-bar bible-mode toggle-text-direction]
  309. '("Toggle text direction (for Hebrew display)" . bible-mode-toggle-text-direction))
  310. (define-key bible-mode-map
  311. [menu-bar bible-mode toggle-tooltip-display]
  312. '("Toggle Tooltip Display" . bible-mode-toggle-tooltips))
  313. (define-key bible-mode-map
  314. [menu-bar bible-mode sepp]
  315. '(menu-item '"--"))
  316. (define-key bible-mode-map
  317. [menu-bar bible-mode select-biblical-text]
  318. '("Select Module" . bible-mode-display-available-modules))
  319. (defun bible-mode--display-greek ()
  320. "This command is run by clicking on text, not directly by the user."
  321. (interactive)
  322. (let ((item (car (split-string (get-text-property (point) 'strong)))))
  323. ;; Remove "strong:G" prefix
  324. (bible-term-greek (replace-regexp-in-string "strong:G" "" item))))
  325. (defconst bible-mode-greek-keymap (make-sparse-keymap))
  326. (define-key bible-mode-greek-keymap (kbd "RET") 'bible-mode--display-greek)
  327. (define-key bible-mode-greek-keymap [mouse-1] 'bible-mode--display-greek)
  328. (defun bible-mode--display-hebrew ()
  329. "This command is run by clicking on text, not directly by the user."
  330. (interactive)
  331. (let ((item (car (split-string (get-text-property (point) 'strong)))))
  332. ;; Remove "strong:H" prefix and any alphabetic suffixes.
  333. (bible-term-hebrew (replace-regexp-in-string "strong:H" "" item))))
  334. (defconst bible-mode-hebrew-keymap (make-sparse-keymap))
  335. (define-key bible-mode-hebrew-keymap (kbd "RET") 'bible-mode--display-hebrew)
  336. (define-key bible-mode-hebrew-keymap [mouse-1] 'bible-mode--display-hebrew)
  337. (defconst bible-mode-lemma-keymap (make-sparse-keymap))
  338. (define-key bible-mode-lemma-keymap (kbd "RET")
  339. (lambda ()
  340. (interactive)
  341. ))
  342. (defconst bible-mode-morph-keymap (make-sparse-keymap))
  343. (define-key bible-mode-morph-keymap (kbd "RET")
  344. (lambda ()
  345. (interactive)
  346. ;;; (let ((thing (thing-at-point 'word)))
  347. ;;; (message "thing at point: %s" thing)
  348. ;;; (message "morph property %s" (get-text-property 0 'field thing))
  349. ))
  350. ;;;; Modes
  351. (define-derived-mode bible-mode special-mode "Bible"
  352. "Mode for reading the Bible.
  353. \\{bible-mode-map}"
  354. (buffer-disable-undo)
  355. (font-lock-mode t)
  356. (use-local-map bible-mode-map)
  357. (setq buffer-read-only t)
  358. (visual-line-mode t))
  359. (define-derived-mode bible-search-mode special-mode "Bible Search"
  360. "Mode for performing Bible searches.
  361. \\{bible-search-mode-map}"
  362. (buffer-disable-undo)
  363. (font-lock-mode t)
  364. (use-local-map bible-search-mode-map)
  365. (setq buffer-read-only t)
  366. (visual-line-mode t)
  367. )
  368. (define-derived-mode bible-term-hebrew-mode special-mode "Bible Term (Hebrew)"
  369. "Mode for researching Hebrew terms in the Bible.
  370. \\{bible-term-hebrew-mode-map}"
  371. (buffer-disable-undo)
  372. (font-lock-mode t)
  373. (use-local-map bible-term-hebrew-mode-map)
  374. (setq buffer-read-only t)
  375. (visual-line-mode t))
  376. (define-derived-mode bible-term-greek-mode special-mode "Bible Term (Greek)"
  377. "Mode for researching Greek terms in the Bible.
  378. \\{bible-term-greek-mode-map}"
  379. (buffer-disable-undo)
  380. (font-lock-mode t)
  381. (use-local-map bible-term-greek-mode-map)
  382. (setq buffer-read-only t)
  383. (visual-line-mode t)
  384. )
  385. (define-derived-mode module-select-mode special-mode "Select Text Module"
  386. (buffer-disable-undo)
  387. (font-lock-mode t)
  388. (setq buffer-read-only t))
  389. ;;;; Functions
  390. ;;;;; Commands
  391. ;;;###autoload
  392. (defun bible-open (&optional book-name chapter verse)
  393. "Create and open a `bible-mode' buffer.
  394. Arguments BOOK-NAME, CHAPTER and VERSE, when supplied, give the starting
  395. verse reference for the buffer. If no optional arguments are supplied,
  396. Genesis 1:1 is used."
  397. (interactive)
  398. (let ((buf (get-buffer-create (generate-new-buffer-name (concat "*bible*")))))
  399. (set-buffer buf)
  400. (bible-mode)
  401. (bible-mode--set-location
  402. (or (assoc (or book-name "Genesis") bible-mode-books) (list book-name))
  403. (or chapter 1)
  404. verse)
  405. (set-window-buffer (get-buffer-window (current-buffer)) buf)))
  406. ;;;###autoload
  407. (defun bible-mode-next-chapter ()
  408. "Page to the next chapter for the active `bible-mode' buffer."
  409. (interactive)
  410. (let* ((book-chapters (cdr bible-mode-current-book))
  411. (chapter (min book-chapters (+ bible-mode-current-chapter 1))))
  412. (bible-mode--set-location bible-mode-current-book chapter)))
  413. ;;;###autoload
  414. (defun bible-mode-previous-chapter ()
  415. "Page to the previous chapter for the active `bible-mode' buffer."
  416. (interactive)
  417. (bible-mode--set-location bible-mode-current-book (max 1 (- bible-mode-current-chapter 1))))
  418. (defun bible-mode-next-word ()
  419. "Move forward a word, taking into account the relevant text properties."
  420. (interactive)
  421. (unless (eobp)
  422. (let ((next-change (text-property-search-forward 'strong nil nil t)))
  423. (when next-change
  424. (goto-char (1- (prop-match-end next-change)))))))
  425. (defun bible-mode-previous-word ()
  426. "Move back a word, taking into account the relevant text properties."
  427. (interactive)
  428. (unless (bobp)
  429. (let ((previous-change (text-property-search-backward 'strong)))
  430. (when previous-change
  431. (goto-char (prop-match-beginning previous-change))))))
  432. ;;;###autoload
  433. (defun bible-mode-select-book ()
  434. "Ask user for a new book and chapter for the current `bible-mode' buffer."
  435. (interactive)
  436. (let* ((completion-ignore-case t)
  437. (book-data (assoc (completing-read "Book: " bible-mode-books nil t) bible-mode-books))
  438. (chapter (string-to-number (completing-read "Chapter: " (bible-mode--list-number-range 1 (cdr book-data)) nil t))))
  439. (setq-local bible-mode-current-book book-data)
  440. (setq-local bible-mode-current-book-name (car book-data))
  441. (setq-local bible-mode-current-chapter chapter)
  442. (bible-mode--display)))
  443. ;;;###autoload
  444. (defun bible-mode-select-chapter ()
  445. "Ask user for a new chapter for the current `bible-mode' buffer."
  446. (interactive)
  447. (let* ((book-chapters (cdr bible-mode-current-book))
  448. (chapter (string-to-number (completing-read "Chapter: " (bible-mode--list-number-range 1 book-chapters) nil t))))
  449. (when chapter
  450. (bible-mode--set-location bible-mode-current-book chapter))))
  451. (defun bible-mode-set-search-range ()
  452. "Ask user for a new text module for the current `bible-mode' buffer."
  453. (interactive)
  454. (let ((range (read-string "Range (<return> to clear): ")))
  455. (if (string-equal range "")
  456. (setq bible-mode-search-range nil)
  457. (setq bible-mode-search-range range))
  458. ;; (bible-mode--display)
  459. ))
  460. ;;;###autoload
  461. (defun bible-mode-select-module ()
  462. "Ask user for a new text module for the current `bible-mode' buffer."
  463. (interactive)
  464. ;; (let* ((bible-mode-module (completing-read "Module: " bible-mode-modules)))
  465. ;; (bible-mode--display))
  466. (setq-default bible-mode-module (completing-read "Module: " bible-mode-modules))
  467. (bible-mode--display))
  468. ;;;###autoload
  469. (defun bible-mode-toggle-word-study ()
  470. "Toggle the inclusion of word study for the active `bible-mode' buffer."
  471. (interactive)
  472. (setq bible-mode-word-study-enabled (not bible-mode-word-study-enabled))
  473. (if (equal major-mode 'bible-search-mode)
  474. (bible-mode--display-search bible-mode-search-query bible-mode-search-mode)
  475. (bible-mode--display)))
  476. (defun bible-mode-toggle-red-letter ()
  477. "Toggle red letter mode for the active `bible-mode' buffer."
  478. (interactive)
  479. (setq bible-mode-red-letter-enabled (not bible-mode-red-letter-enabled))
  480. (if (equal major-mode 'bible-search-mode)
  481. (bible-mode--display-search bible-mode-search-query bible-mode-search-mode)
  482. (bible-mode--display)))
  483. ;;;###autoload
  484. (defun bible-mode-split-display ()
  485. "Copy the active `bible-mode' buffer into a new buffer in another window."
  486. (interactive)
  487. (split-window-right)
  488. (balance-windows)
  489. (other-window 1)
  490. (bible-open bible-mode-current-book-name bible-mode-current-chapter))
  491. ;;;###autoload
  492. (defun bible-search (query)
  493. "Prompts the user for a Bible search query: word or phrase and type of
  494. search: either `lucene', `phrase', `regex' or `multiword'. `lucene' mode
  495. requires an index to be built using the `mkfastmod' program. `lucene' is
  496. the default search."
  497. (interactive "sBible Search: ")
  498. (when (> (length query) 0)
  499. (let* ((bible-mode-module (buffer-local-value 'bible-mode-module (current-buffer)))
  500. (searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
  501. (bible-mode--open-search query searchmode))))
  502. ;;;###autoload
  503. (defun bible-search-mode-follow-verse ()
  504. "Follow the hovered verse in a `bible-search-mode' buffer.
  505. Create a new `bible-mode' buffer positioned at the selected verse."
  506. (interactive)
  507. (let* ((text (thing-at-point 'line t))
  508. book
  509. chapter
  510. verse)
  511. (string-match ".+ [0-9]?[0-9]?[0-9]?:[0-9]?[0-9]?[0-9]?:" text)
  512. (setq text (match-string 0 text))
  513. (string-match " [0-9]?[0-9]?[0-9]?:" text)
  514. (setq chapter (replace-regexp-in-string "[^0-9]" "" (match-string 0 text)))
  515. (string-match ":[0-9]?[0-9]?[0-9]?" text)
  516. (setq verse (replace-regexp-in-string "[^0-9]" "" (match-string 0 text)))
  517. (setq book (replace-regexp-in-string "[ ][0-9]?[0-9]?[0-9]?:[0-9]?[0-9]?[0-9]?:$" "" text))
  518. (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
  519. (defun bible-search-mode-follow-xref ()
  520. "Follow the hovered verse in a bible term buffer.
  521. Create a new `bible-mode' buffer positioned at the specified verse.
  522. XXX We use the current module to avoid opening cans of worms regarding
  523. OT/NT etc. If that module doesn't have that verse...???"
  524. (interactive)
  525. (let* ((xref (get-text-property (point) 'xref))
  526. (verse-ref (string-split xref))
  527. book-abbrev
  528. book
  529. chapter-verse
  530. chapter
  531. verse)
  532. (if (= (length verse-ref) 3) ; II Cor 3:17 or the like
  533. (progn
  534. (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref)))
  535. (setq chapter-verse (split-string (caddr verse-ref) ":")))
  536. (progn ; Mat 5 or the like
  537. (setq book-abbrev (car verse-ref))
  538. (setq chapter-verse (split-string (cadr verse-ref) ":"))))
  539. (setq book (car verse-ref))
  540. (setq chapter (car chapter-verse)
  541. verse (cadr chapter-verse))
  542. (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
  543. ;;;###autoload
  544. (defun bible-term-hebrew (term)
  545. "Query user for a Strong's Hebrew Lexicon TERM."
  546. (interactive "sTerm: ")
  547. (bible-mode--open-term-hebrew term))
  548. ;;;###autoload
  549. (defun bible-term-greek (term)
  550. "Query user for a Strong's Greek Lexicon TERM."
  551. (interactive "sTerm: ")
  552. (bible-mode--open-term-greek term))
  553. ;;;###autoload
  554. (defun bible-insert ()
  555. "Query user to select a verse for insertion into the current buffer."
  556. (interactive)
  557. (let* ((completion-ignore-case t)
  558. (book-data (assoc (completing-read "Book: " bible-mode-books nil t) bible-mode-books))
  559. (chapter (when book-data (completing-read "Chapter: " (bible-mode--list-number-range 1 (cdr book-data)) nil t)))
  560. (verse (when chapter (read-from-minibuffer "Verse: "))))
  561. (when verse
  562. (insert (string-trim
  563. (replace-regexp-in-string
  564. (regexp-opt `(,(concat "(" bible-mode-module ")")))
  565. ""
  566. (bible-mode--exec-diatheke (concat (car book-data) " " chapter ":" verse) nil "plain")))))))
  567. ;;;;; Support
  568. (defconst diatheke-filter-options " avlnmw")
  569. ;;;
  570. ;;; XXX I've mangled this in an ad-hoc manner. It needs to be
  571. ;;; re-written so it is clearer (and correct, for that matter).
  572. (defun bible-mode--exec-diatheke (query &optional filter format searchtype module)
  573. "Execute `diatheke' with specified QUERY options, returning the output."
  574. (let ((module (or module bible-mode-module)))
  575. (with-temp-buffer
  576. (let ((args (list "diatheke" nil (current-buffer) t "-b" module)))
  577. (if searchtype
  578. (progn
  579. (setq filter nil) ; search is not compatible with filters XXX
  580. (setq args (append args (list "-s" (pcase searchtype
  581. ("lucene" "lucene")
  582. ("phrase" "phrase")
  583. ("regex" "regex")
  584. ("multiword" "multiword")))))
  585. (when bible-mode-search-range (setq args (append args (list "-r" bible-mode-search-range)))))
  586. (progn
  587. (if filter
  588. (setq filter (concat filter diatheke-filter-options))
  589. (setq filter diatheke-filter-options))
  590. (setq args (append args (list "-o" filter)))))
  591. (setq args (append args (list "-f" (pcase format ("plain" "plain") (_ "internal")) "-k" query)))
  592. (when bible-mode-show-diatheke-exec
  593. (message "%s" args))
  594. (apply 'call-process args))
  595. (buffer-string))))
  596. (defvar-local bible-mode-chapter-title nil
  597. "Text preceding start of chapter.
  598. Mostly in Psalms, like `Of David' or the like.")
  599. ;;;
  600. ;;; Greek and Hebrew lexicon and morphology tooltip rendering.
  601. ;;;
  602. ;;; Hash tables for Lexical definitions.
  603. (defvar greek-hash (make-hash-table :test 'equal))
  604. (defvar greek-hash-short (make-hash-table :test 'equal))
  605. (defvar hebrew-hash (make-hash-table :test 'equal))
  606. (defvar hebrew-hash-short (make-hash-table :test 'equal))
  607. ;; Do lookups using index to lexicon with lookups by lemma.
  608. (defvar lemma-index-hash (make-hash-table :test 'equal))
  609. (defvar lemma-lex-hash (make-hash-table :test 'equal))
  610. ;;; Hash tables for Morphologies. Three at present.
  611. (defvar robinson-hash (make-hash-table :test 'equal))
  612. (defvar packard-hash (make-hash-table :test 'equal))
  613. (defvar oshm-hash (make-hash-table :test 'equal))
  614. ;;; Use HTMLHREF format with diatheke, post-process to render html.
  615. (defun bible-mode--morph-query (query module)
  616. "Execute `diatheke' to do morph QUERY, using MODULE.
  617. Render HTML, return string. Do some tweaking specific to morphology."
  618. (with-temp-buffer
  619. (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
  620. (when bible-mode-show-diatheke-exec
  621. (message "%s" args))
  622. (apply 'call-process args)
  623. (shr-render-region (point-min) (point-max))
  624. (format-replace-strings
  625. '(("\n:" . "") ; This makes the Packard morphology display look better.
  626. ("Part of Speech" . "")) ; This helps the Robinson display look better.
  627. nil (point-min) (point-max))
  628. (substring (buffer-string) (+ (length query) 1))) ; This tries to get rid of unnecessary query identifier.
  629. ))
  630. ;;; Use "plain" format with diatheke.
  631. (defun bible-mode--lex-query (query module)
  632. "Execute `diatheke' for QUERY, using MODULE.
  633. Plain format, returns string."
  634. ;; Get rid of query ID at front of string: ?????:
  635. (bible-mode--exec-diatheke query nil "plain" nil module))
  636. (defun bible-mode--lookup-lemma-index (key)
  637. "Given a strong's number KEY, return the Greek lemma from lemma index."
  638. (or (gethash key lemma-index-hash)
  639. (puthash key
  640. (string-trim
  641. (replace-regexp-in-string
  642. (concat "(" bible-mode-lexicon-index ")") ""
  643. (bible-mode--lex-query key bible-mode-lexicon-index)))
  644. lemma-index-hash)))
  645. ;;;
  646. ;;; The Greek lexical definitions are done using the HTMLHREF output
  647. ;;; format so they come out looking nice and having clickable
  648. ;;; cross-references and/or Strong's references.
  649. (defun bible-mode--process-href ()
  650. "Fix the XML so cross-references are in the right format.
  651. These cross-references get processed later when the term is displayed.
  652. First, find the links put in by diatheke's HTMLHREF output format.
  653. Replace the links with verse references that get changed to clickable
  654. cross-references when the term is displayed.
  655. The verse refs look like this: <bookname>.<chapter>.<verse>. We convert
  656. them to the <bookname> <chapter>:<verse> format."
  657. (goto-char (point-min))
  658. (while (re-search-forward "<a href=\"passagestudy.*?</a>" nil t) ; HTMLHREF cross references.
  659. (let ((match-text (match-string 0)))
  660. ;; Delete original link.
  661. (replace-match "" nil nil)
  662. ;; Get the verse reference from the string we saved. Put it in
  663. ;; good format, then insert it into buffer where href was.
  664. (when (string-match "value=.*?&" match-text)
  665. (let* ((value-string (match-string 0 match-text))
  666. ;; Strip off value= and trailing &.
  667. (verse-ref-string (substring value-string 6 (1- (length value-string))))
  668. (verse-ref-length (length verse-ref-string))
  669. period)
  670. ;; Convert periods
  671. ;; Substitute first period with space
  672. (when (setq period (cl-search "." verse-ref-string))
  673. (aset verse-ref-string period ? ))
  674. ;; Substitute second period with colon
  675. (when (setq period (cl-search "." verse-ref-string))
  676. (aset verse-ref-string period ?:))
  677. ;; Replace numbers (1, 2 or 3) with roman numerals (I, II, III) XXX Fix?
  678. (pcase (aref verse-ref-string 0)
  679. (?1 (setq verse-ref-string (concat "I" (substring verse-ref-string 1))))
  680. (?2 (setq verse-ref-string (concat "II" (substring verse-ref-string 1))))
  681. (?3 (setq verse-ref-string (concat "III" (substring verse-ref-string 1)))))
  682. (set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
  683. (insert verse-ref-string))))))
  684. (defun bible-mode--lookup-greek-def (key)
  685. "Execute `diatheke' to do query on KEY.
  686. Massage output so verse cross references are usable. Returns string.
  687. We use HTMLHREF format output because it may have verse references
  688. as HTML links, depending on the lexicon module."
  689. (with-temp-buffer
  690. (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-mode-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" key)))
  691. ;; XXX Change to OSIS? Need to parse OSIS-style references.
  692. ;;; (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-mode-greek-lexicon "-o" "m" "-f" "OSIS" "-k" key)))
  693. (when bible-mode-show-diatheke-exec
  694. (message "%s" args))
  695. (apply 'call-process args)
  696. (bible-mode--process-href) ; Clean up XML so xrefs can work after rendering.
  697. (shr-render-region (point-min) (point-max))
  698. (buffer-string))))
  699. (defun bible-mode--lookup-lex-greek-indexed (key)
  700. "Get Greek lemma using Strong's number KEY.
  701. Then look up the definition of that lemma. Used when two-stage
  702. lexical definition is set for a particular lexicon."
  703. (let ((lemma-entry (bible-mode--lookup-lemma-index key))) ; Get lemma from Strong's number
  704. (when lemma-entry
  705. (let ((lemma (caddr (split-string lemma-entry " "))))
  706. (bible-mode--lookup-greek-def lemma)))))
  707. (defun bible-mode--lookup-lex-greek (key)
  708. "Lookup lexical definition using Strong's number KEY.
  709. 1. Check hash table first. If entry found, return.
  710. 2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
  711. 3. Otherwise just use the Strong's number method."
  712. (or (gethash key greek-hash)
  713. (puthash key
  714. (if bible-mode-use-index-for-lexicon
  715. (bible-mode--lookup-lex-greek-indexed key)
  716. (bible-mode--lookup-greek-def key))
  717. greek-hash)))
  718. (defun bible-mode--lookup-strongs-greek (window object pos)
  719. "Look up Greek lexical entry of OBJECT clicked on in WINDOW at POS.
  720. If not found in hash table, get it from sword database. stash in hash
  721. table, and return string.
  722. Note: compiler warns about unused `WINDOW' argument."
  723. (let ((query (get-text-property pos 'strong object))) ; Get Strong's number from text property
  724. (when (string-match "[0-9]+" query)
  725. (bible-mode--lookup-lex-greek (match-string 0 query)))))
  726. (defun bible-mode--lookup-strongs-greek-short (window object pos)
  727. "Look up shorter Greek lexical entry of OBJECT clicked on in WINDOW at POS.
  728. If not found in hash table, get it from sword database, stash in hash table,
  729. and return string.
  730. Note: compiler warns about unused `window' argument."
  731. (let ((query (get-text-property pos 'strong object))) ; Get Strong's number from text property
  732. (when (string-match "[0-9]+" query)
  733. (let ((lookup-key (match-string 0 query)))
  734. (or (gethash lookup-key greek-hash-short)
  735. (let ((raw-text (bible-mode--lex-query lookup-key bible-mode-greek-lexicon-short)))
  736. (puthash lookup-key raw-text greek-hash-short)))))))
  737. (defun bible-mode--lookup-strongs-hebrew (window object pos)
  738. "Look up Hebrew lexical string for object at point.
  739. If not found in hash table, get it from sword database,
  740. stash in hash table, and return string.
  741. Note: compiler warns about unused `window' argument."
  742. (let ((query (get-text-property pos 'strong object)))
  743. (when (string-match "[0-9]+" query)
  744. (let ((lookup-key (concat "H" (match-string 0 query))))
  745. (or (gethash lookup-key hebrew-hash)
  746. (let ((raw-text (bible-mode--lex-query lookup-key bible-mode-hebrew-lexicon)))
  747. (puthash lookup-key raw-text hebrew-hash)))))))
  748. (defun bible-mode--lookup-strongs-hebrew-short (window object pos)
  749. "Look up Hebrew lexical string from short Hebrew lexicon for object
  750. at point. If not found in hash table, get it from sword database,
  751. stash in hash table, and return string.
  752. Note: compiler warns about unused `window' argument."
  753. (let ((query (get-text-property pos 'strong object)))
  754. (when (string-match "[0-9]+" query)
  755. (let ((lookup-key (concat "H" (match-string 0 query))))
  756. (or (gethash lookup-key hebrew-hash-short)
  757. (let ((raw-text (bible-mode--lex-query lookup-key bible-mode-hebrew-lexicon-short)))
  758. (puthash lookup-key raw-text hebrew-hash-short)))))))
  759. (defun bible-mode--morph-database-lookup (query database hash)
  760. (or (gethash query hash)
  761. (puthash query (bible-mode--morph-query query database) hash)))
  762. (defvar bible-mode-outline-strings
  763. '((" I." . "\n I.")
  764. (" II." . "\n II.")
  765. (" III." . "\n III.")
  766. (" IV." . "\n IV.")
  767. (" V." . "\n V.")
  768. (" 1." . "\n 1.")
  769. (" 2." . "\n 2.")
  770. (" 3." . "\n 3.")
  771. (" 4." . "\n 4.")
  772. (" 5." . "\n 5.")
  773. (" 6." . "\n 6.")
  774. (" 7." . "\n 7.")
  775. (" 8." . "\n 8.")
  776. (" 9." . "\n 9.")
  777. (" a." . "\n a.")
  778. (" b." . "\n b.")
  779. (" c." . "\n c.")
  780. (". ." . ".")
  781. (" . " . ". ")))
  782. (defun bible-mode-cleanup-tooltip-text (lex-text)
  783. (dolist (outline-string bible-mode-outline-strings)
  784. (setq lex-text (string-replace (car outline-string) (cdr outline-string) lex-text)))
  785. lex-text)
  786. ;;;
  787. ;;; Get string for tooltip display
  788. ;;;
  789. (defun bible-mode--show-lex-morph (window object pos)
  790. "Get text for tooltip display. Includes both lex and morph
  791. definitions if text module has both tags, otherwise just get
  792. lex definition."
  793. (let* ((lex-morph-text "")
  794. (lex (get-text-property pos 'strong object))
  795. (lex-module nil)
  796. (lex-text
  797. (cond ((string-match "strong:G" lex)
  798. (bible-mode--lookup-strongs-greek-short window object pos))
  799. ((string-match "strong:H" lex)
  800. (bible-mode--lookup-strongs-hebrew-short window object pos)))))
  801. (setq lex-text (string-replace (concat "(" lex-module ")") "" lex-text))
  802. (let* ((morph (get-text-property pos 'morph object))
  803. (morph-module nil)
  804. (morph-text
  805. (cond ((null morph) nil)
  806. ((string-match "robinson:" morph)
  807. (setq morph-module "Robinson")
  808. (bible-mode--morph-database-lookup (replace-regexp-in-string "robinson:" "" morph) morph-module robinson-hash))
  809. ((string-match "packard:" morph)
  810. (setq morph-module "Packard")
  811. (bible-mode--morph-database-lookup (replace-regexp-in-string "packard:" "" morph) morph-module packard-hash))
  812. ((string-match "oshm:" morph)
  813. (setq morph-module "OSHM")
  814. (bible-mode--morph-database-lookup (replace-regexp-in-string "oshm:" "" morph) morph-module oshm-hash)))))
  815. (when lex-text
  816. (setq lex-morph-text (string-trim (bible-mode-cleanup-tooltip-text (string-fill lex-text 75)))))
  817. (when morph-text
  818. (setq lex-morph-text
  819. (concat lex-morph-text "\n\n"
  820. (string-trim (string-replace (concat "(" morph-module ")") "" morph-text)))))
  821. ;; This prevents bogus command substitutions in the tooltip by
  822. ;; removing backslashes. XXX I couldn't figure out a better way
  823. ;; to bypass command substitution in the tooltips.
  824. (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text)))))
  825. (defun bible-mode-handle-divine-name (item)
  826. (insert "LORD")
  827. (let* ((refstart (- (point) (length "LORD")))
  828. (refend (point))
  829. (strongs (dom-attr item 'savlm)))
  830. (add-face-text-property refstart refend 'bold)
  831. (put-text-property refstart refend 'keymap bible-mode-hebrew-keymap)
  832. (when (and strongs (string-match "strong:H.*" strongs))
  833. (put-text-property refstart refend 'help-echo 'bible-mode--show-lex-morph)
  834. (put-text-property refstart refend 'strong (match-string 0 strongs)))))
  835. (defun bible-mode--process-word (item iproperties)
  836. "Handle <w ....> fubar </w> tag. Add tooltips for definitions and morphology.
  837. Also insert lemmas in buffer (must be done after item is inserted in
  838. buffer)."
  839. (let ((word (string-trim (dom-text item)))
  840. (morph (dom-attr item 'morph))
  841. (savlm (dom-attr item 'savlm))
  842. (lemma (dom-attr item 'lemma))
  843. (divinename (dom-by-tag item 'divinename)))
  844. (insert word)
  845. (let ((refstart (- (point) (length word)))
  846. (refend (point)))
  847. ;; Red letter (Yuck, some modules need this below)
  848. (when (plist-get iproperties 'jesus)
  849. (add-face-text-property refstart refend '(:foreground "red")))
  850. ;; Special case this. XXX Some modules do this differently.
  851. (when divinename
  852. (insert " ")
  853. (bible-mode-handle-divine-name item))
  854. ;; lexical definitions
  855. (when (or savlm lemma)
  856. (let ((matched nil)
  857. (item (or savlm lemma)))
  858. (cond ((string-match "strong:G.*" item) ; Greek
  859. (setq matched (match-string 0 item))
  860. (put-text-property refstart refend 'keymap bible-mode-greek-keymap))
  861. ((string-match "strong:H.*" item) ; Hebrew
  862. (setq matched (match-string 0 item))
  863. (put-text-property refstart refend 'keymap bible-mode-hebrew-keymap)))
  864. ;; Add help-echo, strongs reference for tooltips if match.
  865. (when matched
  866. (setq-local bible-mode-has-strongs t)
  867. (put-text-property refstart refend 'help-echo 'bible-mode--show-lex-morph)
  868. (put-text-property refstart refend 'strong matched))))
  869. ;; morphology
  870. (when morph
  871. (let ((matched nil))
  872. (cond ((string-match "robinson:.*" morph) ; Robinson Greek morphology
  873. (setq matched (match-string 0 morph)))
  874. ((string-match "packard:.*" morph) ; Packard Greek morphology --- LXX seems to use this
  875. (setq matched (match-string 0 morph)))
  876. ((string-match "oshm:.*" morph) ; OSHM Hebrew morphology
  877. (setq matched (match-string 0 morph)))
  878. (t nil
  879. ;;(message "Unknown morphology %s" morph)
  880. ))
  881. (when matched
  882. (setq-local bible-mode-has-morphology t)
  883. (put-text-property refstart refend 'morph matched)
  884. (put-text-property refstart refend 'help-echo 'bible-mode--show-lex-morph))))
  885. ;; Insert lemma into buffer. Lemma tag will be part of savlm item.
  886. ;; XXX Should I do lexicon lookups on these lemmas? I don't use
  887. ;; this anyway....
  888. (when (and bible-mode-word-study-enabled savlm (string-match "lemma.*:.*" savlm))
  889. (dolist (word (split-string (match-string 0 savlm) " "))
  890. (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
  891. (insert " " word)
  892. (let ((refstart (- (point) 1 (length word)))
  893. (refend (point)))
  894. (add-face-text-property refstart refend '(:foreground "blue"))
  895. (put-text-property refstart refend 'keymap bible-mode-lemma-keymap)))))))
  896. (defun bible-mode-new-line ()
  897. "Ensure beginning of line. Try to avoid redundant blank lines."
  898. (unless (= (current-column) 0)
  899. (insert "\n")))
  900. (defun bible-mode--insert-domnode-recursive (node &optional iproperties notitle)
  901. "Recursively parses a domnode from `libxml-parse-html-region's usage on text
  902. produced by `bible-mode--exec-diatheke'. INSERTS text into active buffer with
  903. properties.
  904. XXX In processing subnodes, each case will prepend a space if it needs it."
  905. (when (and bible-mode-red-letter-enabled (equal (dom-attr node 'who) "Jesus"))
  906. ;; For red-letter display.
  907. (setq iproperties (plist-put iproperties 'jesus t)))
  908. (dolist (subnode (dom-children node))
  909. (cond ((null subnode) nil)
  910. ((stringp subnode)
  911. (let ((search-string (concat (car bible-mode-current-book) " " (number-to-string bible-mode-current-chapter) ":"))
  912. (start 0))
  913. ;; Delete <Book Ch:> (may be more than one)
  914. (setq subnode (string-replace search-string "" subnode))
  915. ;; Highlight verse number(s)
  916. (while (string-match "^ ?[0-9]+:" subnode start)
  917. (setq start (match-end 0))
  918. (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple") nil subnode)))
  919. ;; Red letter
  920. (when (plist-get iproperties 'jesus)
  921. (add-face-text-property 0 (length subnode) '(:foreground "red") nil subnode))
  922. (insert subnode))
  923. ;;;; Maybe process these at some point? Include footnotes etc.
  924. ;;; ((eq (dom-tag subnode) 'node) nil)
  925. ;;; ((eq (dom-tag subnode) 'lb) nil)
  926. ;; These tags appear in ESV modules (and maybe others?) XXX still not right
  927. ((eq (dom-tag subnode) 'l)
  928. (let ((attributes (dom-attributes subnode)))
  929. (cond ((equal (cdr (assoc 'type attributes)) "x-br")
  930. (bible-mode-new-line))
  931. ((equal (cdr (assoc 'type attributes)) "x-indent")
  932. (insert "\t"))
  933. ((assoc 'level attributes)
  934. (let ((indent (string-to-number (cdr (assoc 'level attributes)))))
  935. (when (= indent 2) (insert "\n\t")))))))
  936. ((eq (dom-tag subnode) 'title) (when (not notitle) (setq bible-mode-chapter-title subnode) (bible-mode-new-line)))
  937. ((eq (dom-tag subnode) 'body) (bible-mode--insert-domnode-recursive subnode iproperties notitle))
  938. ;; NASB Module uses this to indicate OT quotations (and others?).
  939. ((eq (dom-tag subnode) 'seg) (bible-mode--insert-domnode-recursive subnode iproperties notitle))
  940. ((eq (dom-tag subnode) 'divinename) (bible-mode-handle-divine-name subnode))
  941. ;; This tag is used for red letter.
  942. ((eq (dom-tag subnode) 'q) (bible-mode--insert-domnode-recursive subnode iproperties notitle))
  943. ((eq (dom-tag subnode) 'p) (bible-mode--insert-domnode-recursive subnode iproperties notitle))
  944. ((eq (dom-tag subnode) 'w) (insert " ") (bible-mode--process-word subnode iproperties))
  945. ;; Some modules use this for line breaks and such.
  946. ((or (and (eq (dom-tag subnode) 'milestone) (equal (cdr (assoc 'type (dom-attributes subnode))) "line"))
  947. (and (eq (dom-tag subnode) 'div) (equal (cdr (assoc 'type (dom-attributes subnode))) "paragraph")))
  948. (bible-mode-new-line))
  949. ((or (eq (dom-tag subnode) 'transchange) (eq (dom-tag subnode) 'hi))
  950. ;; Word inserted by translation, not in original, give visual indication.
  951. (let ((word (dom-text subnode)))
  952. (insert " " word)
  953. (if (plist-get iproperties 'jesus)
  954. (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
  955. (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50"))))))))
  956. ;;(defvar bible-mode-debugme nil)
  957. (defun bible-mode--display (&optional verse)
  958. "Render text for `bible-mode'.
  959. If VERSE is supplied, set cursor at verse."
  960. ;; Display buffers can have different modules.
  961. (setq-local bible-mode-module (default-value 'bible-mode-module))
  962. ;; Clear buffer and insert the result of calling bible-mode--exec-diatheke.
  963. (setq buffer-read-only nil)
  964. (erase-buffer)
  965. (setq bible-mode-chapter-title nil
  966. bible-mode-has-strongs nil
  967. bible-mode-has-morphology nil)
  968. (insert (bible-mode--exec-diatheke (concat bible-mode-current-book-name ":" (number-to-string bible-mode-current-chapter))))
  969. ;; Parse the xml in the buffer into a DOM tree.
  970. (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
  971. ;; Render the DOM tree into the buffer.
  972. (unless bible-mode-debugme
  973. (erase-buffer)
  974. ;; Looking for the "body" tag in the DOM node.
  975. (bible-mode--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
  976. (goto-char (point-min))))
  977. ;; Remove the module name from the buffer.
  978. (while (search-forward (concat "(" bible-mode-module ")") nil t)
  979. (replace-match ""))
  980. ;; Set the mode line of the biffer.
  981. (setq mode-name (concat "Bible (" bible-mode-current-book-name " " (number-to-string bible-mode-current-chapter) ") "
  982. bible-mode-module
  983. (when bible-mode-has-strongs " Lex")
  984. (when bible-mode-has-morphology " Morph")
  985. ")"))
  986. ;; Deal with chapter titles (i.e. in Psalms)
  987. ;; N.B. This won't change a title inside a chapter, and so it
  988. ;; doesn't work with Psalm 119 where the acrostic letters get
  989. ;; printed as "titles".
  990. (when bible-mode-chapter-title ; This gets set in bible-mode-insert-domnode-recursive.
  991. (goto-char (point-min))
  992. (let ((title-text (dom-texts bible-mode-chapter-title))
  993. (refstart (point-min))
  994. refend)
  995. ;; Insert and make bold the title.
  996. (when (string-or-null-p title-text)
  997. (insert title-text "\n")
  998. (setq refend (point))
  999. (put-text-property refstart refend 'face 'bold))))
  1000. ;; Get rid of spurious spaces.
  1001. (format-replace-strings '(("." . ". ")
  1002. ("," . ", ")
  1003. (";" . "; ")
  1004. (":" . ": ")
  1005. ("?" . "? ")
  1006. ("!" . "! ")
  1007. (" ." . ". ")
  1008. (" ," . ", ")
  1009. (" ;" . "; ")
  1010. (" :" . ": ")
  1011. (" ?" . "? ")
  1012. (" !" . "! ")
  1013. ("“ " . "“")
  1014. ("‘ " . "‘")
  1015. ;;; (" ”" . "”")
  1016. ;;; (" ’" . "’")
  1017. (" " . " ")
  1018. (" " . " ")
  1019. )
  1020. nil (point-min) (point-max))
  1021. (setq buffer-read-only t)
  1022. (goto-char (point-min))
  1023. ;; If optional verse specification go to that verse.
  1024. (when verse
  1025. (goto-char (+ 1 (string-match (regexp-opt `(,(concat (number-to-string verse) ":"))) (buffer-string))))
  1026. ;; (beginning-of-line)
  1027. ))
  1028. (defun bible-mode--list-biblical-modules ()
  1029. "Return a list of accessible Biblical Text modules."
  1030. (let ((text (bible-mode--exec-diatheke "modulelist" nil nil nil "system"))
  1031. modules)
  1032. (catch 'done
  1033. (dolist (line (split-string text "[\n\r]+"))
  1034. (when (equal line "Commentaries:")
  1035. (throw 'done nil))
  1036. (when (not (equal "Biblical Texts:" line))
  1037. (push (split-string line " : ") modules))))
  1038. modules))
  1039. (defun bible-mode-pick-module ()
  1040. "Keymap action function---select module user chooses."
  1041. (interactive)
  1042. (let ((item (get-text-property (point) 'module)))
  1043. (setq-default bible-mode-module item)
  1044. (bible-open)))
  1045. (defconst bible-mode-module-map (make-keymap))
  1046. (define-key bible-mode-module-map [mouse-1] 'bible-mode-pick-module)
  1047. (define-key bible-mode-module-map (kbd "RET") 'bible-mode-pick-module)
  1048. (defun bible-mode-display-available-modules ()
  1049. "Display available modules, allow user to select."
  1050. (interactive)
  1051. (let ((buf (get-buffer-create "Modules"))
  1052. (mods (bible-mode--list-biblical-modules)))
  1053. (set-buffer buf)
  1054. (module-select-mode)
  1055. (setq buffer-read-only nil)
  1056. (erase-buffer)
  1057. (setq-local tab-stop-list '(25))
  1058. (dolist (mod mods)
  1059. (let ((name (string-trim (car mod)))
  1060. (description (string-trim-left (cadr mod))))
  1061. (insert
  1062. (propertize (string-trim name)
  1063. 'face 'bold
  1064. 'module name
  1065. 'help-echo (concat "Select " name)
  1066. 'keymap bible-mode-module-map))
  1067. (move-to-tab-stop)
  1068. (insert (format "%s\n" description))))
  1069. (setq buffer-read-only t)
  1070. (goto-char (point-min))
  1071. (pop-to-buffer buf nil t)))
  1072. ;;;;; Bible Searching
  1073. (defun bible-mode--open-search (query searchmode)
  1074. "Open a search buffer of QUERY using SEARCHMODE in module MOD."
  1075. (let ((buf (get-buffer-create (concat "*bible-search-" (downcase bible-mode-module) "-" query "*"))))
  1076. (set-buffer buf)
  1077. (bible-search-mode)
  1078. (bible-mode--display-search query searchmode)
  1079. (pop-to-buffer buf nil t)))
  1080. (defun bible-mode--display-search (query searchmode)
  1081. "Render results of search QUERY from SEARCHMODE."
  1082. (setq buffer-read-only nil)
  1083. (erase-buffer)
  1084. (let* ((result (string-trim (replace-regexp-in-string
  1085. "Entries .+?--" ""
  1086. (bible-mode--exec-diatheke query nil "plain" searchmode bible-mode-module))))
  1087. (match 0)
  1088. (matchstr "")
  1089. (verses nil)
  1090. (query-verses "")
  1091. fullverses)
  1092. (if (equal result (concat "none (" bible-mode-module ")"))
  1093. (insert "No results found."
  1094. (if (equal searchmode "lucene")
  1095. " Verify index has been build with mkfastmod."
  1096. ""))
  1097. (progn
  1098. (while match
  1099. (setq match (string-match ".+?:[0-9]?[0-9]?" result (+ match (length matchstr)))
  1100. matchstr (match-string 0 result))
  1101. (when match
  1102. (push
  1103. ;; Massage match to make it more sortable, get rid of some characters.
  1104. (replace-regexp-in-string
  1105. "I " "1"
  1106. (replace-regexp-in-string
  1107. "II " "2"
  1108. (replace-regexp-in-string
  1109. "III " "3"
  1110. (replace-regexp-in-string ".+; " "" matchstr))))
  1111. verses)))
  1112. (setq match 0)
  1113. (setq verses (sort verses))
  1114. (dolist (verse verses)
  1115. (if query-verses
  1116. (setq query-verses (concat query-verses ";" verse))
  1117. (setq query-verses verse)))
  1118. (setq fullverses (let ((bible-mode-show-diatheke-exec nil))
  1119. (bible-mode--exec-diatheke query-verses nil nil nil bible-mode-module)))
  1120. (insert fullverses)
  1121. (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
  1122. (erase-buffer)
  1123. (bible-mode--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
  1124. (goto-char (point-min))
  1125. (while (search-forward (concat "(" bible-mode-module ")") nil t)
  1126. (replace-match "")))))
  1127. (setq mode-name (concat "Bible Search (" bible-mode-module))
  1128. (when bible-mode-search-range
  1129. (setq mode-name (concat mode-name " [" bible-mode-search-range "]")))
  1130. (setq mode-name (concat mode-name ")"))
  1131. (setq buffer-read-only t)
  1132. (setq-local bible-mode-search-query query)
  1133. (setq-local bible-mode-search-mode searchmode)
  1134. (goto-char (point-min))))
  1135. ;;;;; Terms
  1136. ;;(defun bible-mode-display-morphology (morph)
  1137. ;; ;; xxx Do something here?
  1138. ;; )
  1139. (defun bible-mode--display-term (termtype)
  1140. (setq buffer-read-only nil)
  1141. (goto-char (point-min))
  1142. ;; This enables clicking on Strong's numbers in some lexicon definitions.
  1143. (while (search-forward-regexp "[0-9]+" nil t)
  1144. (cond ((eq termtype 'hebrew)
  1145. (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:H" (match-string 0)))
  1146. (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-mode-hebrew-keymap)
  1147. (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))
  1148. ((eq termtype 'greek)
  1149. (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:G" (match-string 0)))
  1150. (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-mode-greek-keymap)
  1151. (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))))
  1152. (goto-char (point-min))
  1153. ;; This enables clicking on verse references.
  1154. (while (search-forward-regexp bible-mode-verse-regexp nil t)
  1155. (put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
  1156. (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
  1157. (put-text-property (match-beginning 0) (match-end 0) 'help-echo (concat "Go to " (match-string 0)))
  1158. (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue")))
  1159. (goto-char (point-min))
  1160. (while (search-forward "()" nil t)
  1161. (replace-match ""))
  1162. (goto-char (point-min))
  1163. (setq buffer-read-only t))
  1164. (defun bible-mode--open-term-hebrew (term)
  1165. "Open a buffer of the Strong's Hebrew TERM's definition."
  1166. (let ((buf (get-buffer-create (concat "*bible-term-hebrew-" term "*"))))
  1167. (set-buffer buf)
  1168. (bible-term-hebrew-mode)
  1169. (bible-mode--display-term-hebrew term)
  1170. (pop-to-buffer buf nil t)
  1171. (fit-window-to-buffer)))
  1172. (defun bible-mode--open-term-greek (term)
  1173. "Open a buffer of the Strong's Greek TERM definition."
  1174. (let ((buf (get-buffer-create (concat "*bible-term-greek-" term "*"))))
  1175. (set-buffer buf)
  1176. (bible-term-greek-mode)
  1177. (bible-mode--display-term-greek term)
  1178. (pop-to-buffer buf nil t)
  1179. (fit-window-to-buffer)))
  1180. ;;;
  1181. ;;; Note: Hebrew display of terms is backwards; set bidi direction to
  1182. ;;; 'left-to-right.
  1183. (defun bible-mode--display-term-hebrew (term)
  1184. "Render the definition of the Strong's Hebrew TERM.
  1185. Sets bidi-paragraph-direction so the English text will render
  1186. left-to-right. XXX Why doesn't this work for the tooltips?"
  1187. (setq buffer-read-only nil)
  1188. (erase-buffer)
  1189. (insert (replace-regexp-in-string
  1190. (regexp-opt `(,bible-mode-hebrew-lexicon))
  1191. ""
  1192. (bible-mode--exec-diatheke term nil "plain" nil bible-mode-hebrew-lexicon)
  1193. nil nil nil 7
  1194. ))
  1195. (bible-mode--display-term 'hebrew)
  1196. (setq bidi-paragraph-direction 'left-to-right))
  1197. (defun bible-mode--display-term-greek (term)
  1198. "Render the definition of the Strong's Greek TERM."
  1199. (setq buffer-read-only nil)
  1200. (erase-buffer)
  1201. (insert (replace-regexp-in-string
  1202. (regexp-opt `(,bible-mode-greek-lexicon))
  1203. ""
  1204. (bible-mode--lookup-lex-greek term)))
  1205. (bible-mode--display-term 'greek))
  1206. (defun bible-mode--set-location (book chapter &optional verse)
  1207. "Set the BOOK, CHAPTER and optionally VERSE of the active `bible-mode' buffer."
  1208. (setq-local bible-mode-module (default-value 'bible-mode-module))
  1209. (setq-local bible-mode-current-book book)
  1210. (setq-local bible-mode-current-book-name (car book))
  1211. (setq-local bible-mode-current-chapter chapter)
  1212. (bible-mode--display verse))
  1213. ;;;;; Utilities
  1214. (defun bible-mode--list-number-range (min max &optional prefix)
  1215. "Returns a list containing entries for each integer between MIN and MAX.
  1216. If PREFIX is supplied, prepend PREFIX to the entries.
  1217. Used in tandem with `completing-read' for chapter selection."
  1218. (let ((range-list nil))
  1219. (dotimes (num (1+ max))
  1220. (when (>= num min)
  1221. (push (cons (concat prefix (number-to-string num)) num) range-list)))
  1222. (nreverse range-list)))
  1223. ;;; Provides
  1224. (provide 'bible-mode)
  1225. ;; Local Variables:
  1226. ;; End: