Miscellaneous cleanups and improvements to tooltips.

bible.el

@@ -20,18 +20,52 @@
 ;; Biblical texts provided by the Sword project.
 ;; Word study is also supported.
 
-;;; Usage:
+;;; Installation:
 
 ;; First install `diatheke'.  On Debian/Ubuntu it's in the `diatheke'
 ;; package. In other distributions it might be in the sword package.
 
+;; Next get the Bible texts (modules) you want to use. This can be
+;; done with the installmgr utility, or if you use a program like
+;; BibleTime or Xiphos you can use the GUI interface that they
+;; provide.
+;;
+;; The code is written to work well with the following modules:
+;;
+;; KJV --- has Strongs references for OT, Strongs references and
+;; Robinson morphology codes for NT.
+;;
+;; NASB --- has Strongs references.
+;;
+;; AbbottSmithStrongs --- A fairly extensive Greek lexicon
+;;
+;; BDBGlosses_Strongs --- A Hebrew lexicon, more extensive than
+;; StrongsRealHebrew.
+;;
+;; StrongsRealGreek / StrongsRealHebrew --- Shorter Greek and Hebrew
+;; lexicons.
+;;
+;; Robinson --- Morphological codes 
+;;
+;; Packard --- Morphological codes (used by LXX which is a
+;; Morphologically tagged version of the Septuagint)
+;;
+;; OSHM --- Hebrew morphological codes used by OSHB.
+;;
+;; OSHB --- Hebrew Bible with Strongs references and morphological
+;; codes.
+
 ;; For Windows I found that you can simply install the Xiphos package.
 ;; It includes the Sword library and its utilities including diatheke,
 ;; installmgr and mkfastmod. Add the "Program Files\Xiphos\bin" path
 ;; to your execution path.
 
+;;; Usage:
+
 ;; Use M-x `bible-open' to open a Bible buffer.
 ;; Use C-h f `bible' to see available keybindings.
+;; The program also installs a Bible menu with keybindings and other
+;; commands.
 
 ;; You may customize `bible-module' to set a default browsing
 ;; module, as well as `bible-word-study-enabled' to enable word
@@ -51,7 +85,7 @@
 ;; references. This is for red letters, purple highlighting of the
 ;; verse numbers, bold face of the divine name in the OT and so on.
 
-;; If strongs tags and/or morphological tags are present, they are
+;; If Strongs tags and/or morphological tags are present, they are
 ;; looked up in appropriate lexical and morphological modules and used
 ;; to add tooltips to the text so that mousing over words will bring
 ;; up a tooltip with information about the word. Clicking on a word
@@ -60,12 +94,11 @@
 
 ;;; Code:
 
-
 ;;;; Requirements
 (require 'dom)
 (require 'shr)
 
-;; Turn off tool bar mode because we want the pixels....
+;; Turn off tool bar mode because we are greedy for pixels....
 (tool-bar-mode -1)
 
 ;;;; Variables
@@ -94,7 +127,10 @@
 
 
 (defcustom bible-greek-lexicon
-  "AbbottSmith"
+  ;; AbbottSmithStrongs now has both links to lemmas and definitions
+  ;; keyed by lemma. So we only need the AbbottSmithStrongs lexicon
+  ;; and not the AbbottSmith lexicon.
+  "AbbottSmithStrongs" 
   "Lexicon used for displaying definitions of Greek words using Strong's codes."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealGreek\").")
   :local nil
@@ -103,10 +139,9 @@
 
 (defcustom bible-use-index-for-lexicon t
   "Some lexicons are accessed by lemmas rather than Strong's numbers.
-Use an index to look up lemmas from Strong's numbers so these lexicons can
-be used.  Examples of this type of lexicon are AbbottSmith and
-LiddellScott.  XXX LiddellScott currently doesn't work.  XXX AbbottSmithStrongs
-now has the complete entries instead of just links."
+Use an index to look up lemmas from Strong's numbers so these lexicons
+can be used. XXX AbbottSmithStrongs now has both links and complete
+entries instead of just links."
   :type 'boolean
   :local nil
   :group 'bible)
@@ -129,15 +164,19 @@ which are of the form
   :local nil
   :group 'bible)
 
+
+;;; XXX The Hebrew lexicons differ on whether they accept keys of the
+;;; form `Hnnnn' or `nnnn'. The code does not yet handle this
+;;; correctly, so stick with the following.
 (defcustom bible-hebrew-lexicon
-  "StrongsRealHebrew"
+  "BDBGlosses_Strongs" ; This seems to work
   "Lexicon used for displaying definitions of Hebrew words using Strong's codes."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
   :group 'bible)
 
 (defcustom bible-hebrew-lexicon-short
-  "BDBGlosses_Strongs" ; This seems to work
+  "StrongsRealHebrew"
   "Lexicon used for displaying definitions of Hebrew words in tooltips."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
@@ -274,9 +313,6 @@ which are of the form
 (defvar-local bible-has-morphology nil
   "Set if the module being displayed has morphology availabile.")
 
-
-;; (defvar bible--current-module nil)
-
 ;;;; Keymaps
 
 ;;;; N.B. Bible menu items appear in reverse order of their
@@ -416,6 +452,9 @@ which are of the form
   "Query used in toggles (word study and red letter).")
 
 (defvar bible-use-tooltips t)
+(setq tooltip-delay 1)
+(setq tooltip-short-delay .5)
+(setq use-system-tooltips nil)
 
 (defun bible-toggle-tooltips ()
   "Toggle use of tooltips to display lexical/morphological items."
@@ -425,7 +464,6 @@ which are of the form
   (setq tooltip-resize-echo-area bible-use-tooltips))
 
 
-
 (define-key bible-map
 	    [menu-bar bible sepp]
 	    '(menu-item '"--"))
@@ -446,6 +484,7 @@ which are of the form
 	    [menu-bar bible select-biblical-text]
 	    '("Select Module" . bible-display-available-modules))
 
+
 (defun bible--display-greek ()
   "Display Greek text.
 This command is run by clicking on text, not directly by the user."
@@ -475,6 +514,7 @@ This command is run by clicking on text, not directly by the user."
 	    (lambda ()
 	      (interactive)))
 
+;; Not used. Not really sure what to do here or if it's useful to do anything.
 (defconst bible-morph-keymap (make-sparse-keymap))
 (define-key bible-morph-keymap (kbd "RET")
 	    (lambda ()
@@ -585,9 +625,9 @@ Genesis 1:1 is used."
 	 (book-data-string (car book-data))
          (chapter (string-to-number (completing-read "Chapter [1]: " (bible--list-number-range 1 (cdr book-data)) nil t nil nil "1"))))
     (pcase (aref book-data-string 0)
-      (?1 (setq book-data (cons (concat "I" (seq-subseq book-data-string 1)) (cdr book-data))))
-      (?2 (setq book-data (cons (concat "II" (seq-subseq book-data-string 1)) (cdr book-data))))
-      (?3 (setq book-data (cons (concat "III" (seq-subseq book-data-string 1)) (cdr book-data)))))
+      (?1 (setq book-data (cons (concat "I" (substring book-data-string 1)) (cdr book-data))))
+      (?2 (setq book-data (cons (concat "II" (substring book-data-string 1)) (cdr book-data))))
+      (?3 (setq book-data (cons (concat "III" (substring book-data-string 1)) (cdr book-data)))))
     (setq-local bible--current-book book-data)
     (setq-local bible--current-book-name (car book-data))
     (setq-local bible--current-chapter chapter)
@@ -614,9 +654,6 @@ Genesis 1:1 is used."
 (defun bible-select-module ()
   "Ask user for a new text module for the current `bible' buffer."
   (interactive)
-;;  (let* ((bible-module (completing-read "Module: " bible--modules)))
-;;    (bible--display))
-
   (setq-default bible-module (completing-read "Module: " bible--modules))
   (bible--display))
 
@@ -624,19 +661,13 @@ Genesis 1:1 is used."
   "Toggle the inclusion of word study for the active `bible' buffer."
   (interactive)
   (setq bible-word-study-enabled (not bible-word-study-enabled))
-;;  (if (equal major-mode 'bible-search-mode)
-;;      (bible--display-search bible-search-query bible-search-mode)
   (bible--display))
-;;)
 
 (defun bible-toggle-red-letter ()
   "Toggle red letter mode for the active `bible' buffer."
   (interactive)
   (setq bible-red-letter-enabled (not bible-red-letter-enabled))
-;;  (if (equal major-mode 'bible-search-mode)
-;;      (bible--display-search bible-search-query bible-search-mode)
     (bible--display))
-;;)
 
 (defun bible-split-display ()
   "Copy the active `bible' buffer into a new buffer in another window."
@@ -683,7 +714,7 @@ OT/NT etc. If that module doesn't have that verse...???
 Handle abbreviations from lexicon module (AbbottSmith)."
   (interactive)
   (let* ((xref (get-text-property (point) 'xref))
-	 (verse-ref (string-split xref))
+	 (verse-ref (split-string xref))
 	 book-abbrev
 	 book
 	 chapter-verse
@@ -703,6 +734,10 @@ Handle abbreviations from lexicon module (AbbottSmith)."
 	  verse   (cadr chapter-verse))
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
 
+
+;;; These can be called interactively if you know the Strong's number
+;;; you want to look up.
+
 (defun bible-term-hebrew (term)
   "Query user for a Strong's Hebrew Lexicon TERM."
   (interactive "sTerm: ")
@@ -713,22 +748,20 @@ Handle abbreviations from lexicon module (AbbottSmith)."
   (interactive "sTerm: ")
   (bible--open-term-greek term))
 
+;;; Interactively insert a verse into an arbitrary current buffer.
 (defun bible-insert ()
   "Query user to select a verse for insertion into the current buffer."
   (interactive)
   (let* ((completion-ignore-case t)
 	 (book-data (assoc (completing-read "Book: " bible--books nil t) bible--books))
          (chapter (when book-data (completing-read "Chapter: " (bible--list-number-range 1 (cdr book-data)) nil t "1" nil "1")))
-         (verse (when chapter (read-from-minibuffer "Verse: "))))
-    (when verse
-      (insert (string-trim
-	       (replace-regexp-in-string
-		(regexp-opt `(,(concat "(" bible-module ")")))
-		""
-		(bible--exec-diatheke (concat (car book-data) " " chapter ":" verse) nil "plain")))))))
+         (verse (when chapter (read-from-minibuffer "Verse: ")))
+	 (query (concat (car book-data) " " chapter ":" verse))
+	 (args (list "diatheke" nil (current-buffer) t "-b" bible-module "-f" "plain" "-k" query)))
+    (apply 'call-process args)))
 
-;;;;; Support
 
+;;;;; Support
 
 (defconst bible-diatheke-filter-options " avlnmw")
 
@@ -773,7 +806,16 @@ module."
     (buffer-string)))
 
 
-
+;;; XXX Bible chapter titles mostly appear in Psalms. This code works
+;;; OK except for Psalm 119 which uses the chapter title as a heading
+;;; for each verse of the psalm.
+;;;
+;;; Chapter titles seem to be part of each verse in the modules I saw.
+;;;
+;;; Fixing this issue would require keeping track of the current
+;;; chapter title and emitting the title whenever it changed. Since
+;;; there is (AFAIK) only one chapter in the Bible that has this
+;;; issue, it doesn't seem like a high priority now.
 (defvar-local bible-chapter-title nil
   "Text preceding start of chapter.
 Mostly in Psalms, like `Of David' or the like.")
@@ -784,11 +826,8 @@ Mostly in Psalms, like `Of David' or the like.")
 ;;;
 
 ;;; Hash tables for Lexical definitions.
-(defvar bible-greek-hash (make-hash-table :test 'equal :size 10000))
-(defvar bible-hebrew-hash (make-hash-table :test 'equal :size 10000))
-
-;; Do lookups using index to lexicon with lookups by lemma.
-(defvar bible-lemma-index-hash (make-hash-table :test 'equal :size 10000))
+(defvar bible-hash-greek (make-hash-table :test 'equal :size 10000))
+(defvar bible-hash-hebrew (make-hash-table :test 'equal :size 10000))
 
 ;;; Hash tables for tooltips.
 (defvar lex-hash (make-hash-table :test 'equal :size 10000))
@@ -815,19 +854,15 @@ Render HTML, return string.  Do some tweaking specific to morphology."
 (defun bible--lex-query (query module)
   "Execute `diatheke' for QUERY, using MODULE. 
 Plain format, returns string."
-  ;; Get rid of query ID at front of string: ?????:
   (bible--exec-diatheke query nil "plain" module))
 
 
 (defun bible--lookup-lemma-index (key)
   "Return the Greek lemma from lemma index with a strong's number as KEY."
-  (or (gethash key bible-lemma-index-hash)
-      (puthash key
-	       (string-trim
-		(replace-regexp-in-string
-		 (concat "(" bible-lexicon-index ")") ""
-		 (bible--lex-query key bible-lexicon-index)))
-	       bible-lemma-index-hash)))
+  (string-trim
+   (string-replace
+    (concat "(" bible-lexicon-index ")") ""
+    (bible--lex-query key bible-lexicon-index))))
 
 ;;;
 ;;; The Greek lexical definitions are done using the HTMLHREF output
@@ -872,83 +907,88 @@ them to the <bookname> <chapter>:<verse> format."
 	  (set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
 	  (insert verse-ref-string))))))
 
-(defun bible--lookup-greek-def (key)
+(defun bible--lookup-def-greek (key)
   "Execute `diatheke' to do query on KEY.
-Massage output so verse cross references are usable.  Returns string.
-We use HTMLHREF format output because it may have verse references
-as HTML links, depending on the lexicon module."
-
+Massage output so verse cross references are usable.  Returns string."
   (with-temp-buffer
-    (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" key)))
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "plain" "-k" key)))      
       (when bible-show-diatheke-exec
 	(message "%s" args))
       (apply 'call-process args)
-      (bible--process-href)    ; Clean up XML so xrefs can work after rendering.
-      (shr-render-region (point-min) (point-max))
-      (buffer-string))))
+      (bible--cleanup-lex-text (string-replace (concat "(" bible-greek-lexicon ")") "" (buffer-string))))))
 
-(defun bible--lookup-lex-greek-indexed (key)
+(defun bible--lookup-lemma-greek-indexed (key)
   "Lookup Greek lemma using Strong's number KEY.
 Then look up the definition of that lemma.  Used when two-stage
 lexical definition is set for a particular lexicon."
   (let ((lemma-entry (bible--lookup-lemma-index key))) ; Get lemma from Strong's number
     (when lemma-entry
       (let ((lemma (caddr (split-string lemma-entry " "))))
-	(bible--lookup-greek-def lemma)))))
+	(bible--lookup-def-greek lemma)))))
 
 
-(defun bible--lookup-lex-greek (key)
+(defun bible--lookup-lemma-greek (key)
   "Lookup lexical definition using Strong's number KEY.
 1. Check hash table first.  If entry found, return.
 2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
 3. Otherwise just use the Strong's number method."
-  (or (gethash key bible-greek-hash)
+  (or (gethash key bible-hash-greek)
       (puthash key
 	       (if bible-use-index-for-lexicon
-		   (bible--lookup-lex-greek-indexed key)
-		 (bible--lookup-greek-def key))
-	       bible-greek-hash)))
-
-(defun bible--lookup-strongs-greek (_window object pos)
-  "Look up Greek lexical entry of OBJECT clicked on in WINDOW at POS.
-If not found in hash table, get it from sword database.  Stash in hash
-table, and return string."
-  (let ((query (get-text-property pos 'strong object)))  ; Get Strong's number from text property
-    (when (string-match "[0-9]+" query)
-      (bible--lookup-lex-greek (match-string 0 query)))))
-
-(defun bible--lookup-strongs-hebrew (_window object pos)
-  "Look up Hebrew lexical string for OBJECT at point POS.
-If not found in hash table, get it from sword database,
-stash in hash table, and return string."
-  (let ((query (get-text-property pos 'strong object)))
-    (when (string-match "[0-9]+" query)
-      (let ((lookup-key (concat "H" (match-string 0 query))))
-	(or (gethash lookup-key bible-hebrew-hash)
-	    (let ((raw-text (bible--lex-query lookup-key bible-hebrew-lexicon)))
-	      (puthash lookup-key raw-text bible-hebrew-hash)))))))
+		   (bible--lookup-lemma-greek-indexed key)
+		 (bible--lookup-def-greek key))
+	       bible-hash-greek)))
+
+
+(defun bible--lookup-def-hebrew (key)
+  "Execute `diatheke' to do query on KEY.
+Massage output so various cross references are usable. Returns string."
+  (with-temp-buffer
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-hebrew-lexicon "-f" "plain" "-k" key)))
+      (when bible-show-diatheke-exec
+	(message "%s" args))
+      (apply 'call-process args)
+      (bible--process-href)
+      (string-replace (concat "(" bible-hebrew-lexicon ")") "" (substring (buffer-string) 7)))))
+
+
+(defun bible--lookup-lemma-hebrew (key)
+  "Lookup lexical definition using Strong's number KEY.
+1. Check hash table first.  If entry found, return.
+2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
+3. Otherwise just use the Strong's number method."
+  (or (gethash key bible-hash-hebrew)
+      (puthash key
+	       (bible--lookup-def-hebrew key)
+	       bible-hash-hebrew)))
 
 ;;;
 ;;; We use the shorter lexicons for text in tooltips. We also cache
 ;;; the lex and morph strings, hoping to speed up tooltip rendering.
 ;;;
-(defun bible--lookup-strongs-greek-short (lex)
+(defun bible--lookup-lemma-greek-short (lemma)
   "Look up Greek lexical entry for LEX from short Greek lexicon."
-  (when (string-match "[0-9]+" lex)
-    (bible--lex-query (match-string 0 lex) bible-greek-lexicon-short)))
+  (when (string-match "[0-9]+" lemma)
+    (bible--lex-query (match-string 0 lemma) bible-greek-lexicon-short)))
 
-(defun bible--lookup-strongs-hebrew-short (lex)
-  "Look up Hebrew lexical entry for LEX from short Hebrew lexicon."
-  (when (string-match "[0-9]+" lex)
-    (bible--lex-query lex bible-hebrew-lexicon-short)))
+(defun bible--lookup-lemma-hebrew-short (lemma)
+  "Look up Hebrew lexical entry for LEX from short Hebrew 
+lexicon (StrongsRealGreek)."
+  (when (string-match "[0-9]+" lemma)
+    ;; Remove redundant stuff at the beginnning.
+    (string-fill (substring (bible--lex-query (match-string 0 lemma) bible-hebrew-lexicon-short) 7) 75)))
 
 (defun bible--lookup-lex (lex)
   "Look up lexical item LEX. This is used for tooltips.
 Return hash table entry if present in lex-hash cache, else look up in
 database and stash in cache."
   (when lex
-    (let* ((key (seq-subseq lex 7)) ; strip off "strong:" prefix.
+    (let* ((key (substring lex 7)) ; strip off "strong:" prefix.
 	   (lex-text (gethash key lex-hash)))
+      ;; XXX Kludge alert! Emacs tooltips look really nice for Greek
+      ;; terms, but Hebrew needs system tooltips because of direction
+      ;; issues.
+      (setq use-system-tooltips (if (string-prefix-p "G" key) nil t))
       (if lex-text
 	  lex-text
       	(setq lex-text
@@ -956,17 +996,17 @@ database and stash in cache."
 		     (string-replace 
 		      (concat "(" bible-greek-lexicon-short ")") 
 		      ""
-		      ;; The Greek text doesn't have line breaks, so limit lines to 75 chars.
-		      (string-fill (bible--lookup-strongs-greek-short key) 75)))
+		      ;; The Greek lexicon entries don't have line breaks, so limit lines to 75 chars.
+		      (string-fill (bible--lookup-lemma-greek-short key) 75)))
 		    ((string-prefix-p "H" key)
 		     (string-replace
 		      (concat "(" bible-hebrew-lexicon-short ")")
 		      ""
-		      (bible--lookup-strongs-hebrew-short key)))))
-	(puthash key (bible--cleanup-tooltip-text lex-text) lex-hash)))))
+		      (string-fill (bible--lookup-lemma-hebrew-short key) 75)))))
+	(puthash key (bible--cleanup-lex-text lex-text) lex-hash)))))
 
-(defun bible--lookup-morph (morph)
-  "Look up morphological item MORPH. 
+(defun bible--lookup-morph-entry (morph)
+  "Look up entry for morphological item MORPH. 
 Return hash table entry if present in morph-hash cache, else look up in
 database and stash in cache."
   (when morph
@@ -975,13 +1015,13 @@ database and stash in cache."
 		 (let (morph-module morph-key)
 		   (cond ((string-prefix-p "robinson:" morph)
 			  (setq morph-module "Robinson")
-			  (setq morph-key (seq-subseq morph (length "robinson:"))))
+			  (setq morph-key (substring morph (length "robinson:"))))
 			 ((string-prefix-p "packard:" morph)
 			  (setq morph-module "Packard")
-			  (setq morph-key (seq-subseq morph (length "packard:"))))
+			  (setq morph-key (substring morph (length "packard:"))))
 			 ((string-prefix-p "oshm:" morph)
 			  (setq morph-module "OSHM")
-			  (setq morph-key (seq-subseq morph (length "oshm:")))))
+			  (setq morph-key (substring morph (length "oshm:")))))
 		   (string-replace (concat "(" morph-module ")")
 				   ""
 				   (bible--morph-query morph-key morph-module)))
@@ -1021,7 +1061,7 @@ database and stash in cache."
     (" III. ."	.	" III.")
     (" IV. ."	.	" IV.")
     (" V. ."	.	" V.")
-    ("1. ."	.	"\n1.")
+    ("1. ."	.	"\n 1.")
     ("2. ."	.	"2.")
     ("3. ."	.	"3.")
     ("4. ."	.	"4.")
@@ -1030,7 +1070,8 @@ database and stash in cache."
     ("7. ."	.	"7.")
     ("8. ."	.	"8.")
     ("9. ."	.	"9.")
-    ("a. ."	.	"    a.")
+    ("a. ."	.	"\n    a.")
+    ("(a)."	.	"\n    (a).")
     ("b. ."	.	"    b.")
     ("c. ."	.	"    c.")
     ("d. ."	.	"    d.")
@@ -1038,16 +1079,16 @@ database and stash in cache."
     ("f. ."	.	"    f.")
     ("g. ."	.	"    g.")
     ("h. ."	.	"    h.")
-    (" . "	.	". ")))
+    (" . "	.	". ")
+    ("\n\n"	.	"\n")))
 
-(defun bible--cleanup-tooltip-text (lex-text)
+(defun bible--cleanup-lex-text (lex-text)
   "Reformat tooltip text LEX-TEXT so tooltips look nice."
   (dolist (outline-string bible-outline-strings)
     (setq lex-text (string-replace (car outline-string) (cdr outline-string) lex-text)))
     lex-text)
 
 
-
 ;;;
 ;;; Get string for tooltip display
 ;;;
@@ -1055,22 +1096,22 @@ database and stash in cache."
   "Get text for tooltip display for OBJECT at POS in WINDOW.
 Includes both lex and morph definitions if text module has
 both tags, otherwise just get lex definition."
-  (let* ((lex-morph-text "")
-	 (lex (get-text-property pos 'strong object))
+  (let* ((lex (get-text-property pos 'strong object))
 	 (lex-text (bible--lookup-lex lex))
 	 (morph (get-text-property pos 'morph object))
-	 (morph-text (bible--lookup-morph morph)))
+	 (morph-text (bible--lookup-morph-entry morph)))
     (when lex-text
-      ;;      (setq lex-morph-text (string-trim (string-fill lex-text 75))))
-      (setq lex-morph-text (string-trim lex-text)))
-    (when morph-text
-      (setq lex-morph-text
-	    (concat lex-morph-text "\n" (string-trim morph-text))))
-    ;; This prevents bogus command substitutions in the tooltip by
-    ;; removing backslashes. XXX I couldn't figure out a better way
-    ;; to bypass command substitution in the tooltips.
-    (setq lex-morph-text (subst-char-in-string ?\\ ?  lex-morph-text))
-    lex-morph-text))
+      ;; This prevents bogus command substitutions in the tooltip by
+      ;; removing backslashes. XXX I couldn't figure out a better way
+      ;; to bypass command substitution in the tooltips.
+      (subst-char-in-string 
+       ?\\ 
+       ?
+       (if morph-text
+	   (concat (string-trim lex-text) "\n" (string-trim morph-text))
+	 (string-trim lex-text))))))
+
+
 
 
 (defun bible-handle-divine-name (item)
@@ -1088,18 +1129,19 @@ both tags, otherwise just get lex definition."
 
 (defun bible--process-word (item iproperties)
   "Handle <w ...> fubar </w> tag in ITEM. Check IPROPERTIES for qualifiers.
-Add tooltips for definitions and morphology.  Also insert lemmas in buffer
-(must be done after item is inserted in buffer)."
+Add tooltips for definitions and morphology. Also insert lemmas in
+buffer if `word study' is turned on (must be done after item is inserted
+in buffer)."
   (let ((word (string-trim (dom-text item)))
 	(morph (dom-attr item 'morph))
 	(savlm (dom-attr item 'savlm))
 	(lemma (dom-attr item 'lemma))
 	(divinename (dom-by-tag item 'divinename)))
 
-    (insert word)
+    (let ((refstart (point))
+	  (refend (+ (point) (length word))))
 
-    (let ((refstart (- (point) (length word)))
-	  (refend  (point)))
+      (insert word)
 
       ;; Red letter (Yuck, some modules need this below)
       (when (plist-get iproperties 'jesus)
@@ -1111,14 +1153,16 @@ Add tooltips for definitions and morphology.  Also insert lemmas in buffer
 	(bible-handle-divine-name item))
 
       ;; lexical definitions
-      (when (or savlm lemma)
-	(let ((matched nil)
-	      (item (or savlm lemma)))
-	  (cond ((string-match "strong:G.*" item)        ; Greek
-		 (setq matched (match-string 0 item))
+      (when (or lemma savlm)
+	(let* ((matched nil)
+	       (lexemes (split-string (or lemma savlm)))
+	       ;; XXX KJV module conflates articles with lemmas. Deal with this.
+	       (lexeme (if (> (length lexemes) 2) (nth 1 lexemes) (nth 0 lexemes))))
+	  (cond ((string-match "strong:G.*" lexeme) ; Greek
+		 (setq matched (match-string 0 lexeme))
 		 (put-text-property refstart refend 'keymap bible-greek-keymap))
-		((string-match "strong:H.*" item)        ; Hebrew
-		 (setq matched (match-string 0 item))
+		((string-match "strong:H.*" lexeme) ; Hebrew
+		 (setq matched (match-string 0 lexeme))
 		 (put-text-property refstart refend 'keymap bible-hebrew-keymap)))
 	  ;; Add help-echo, strongs reference for tooltips if match.
 	  (when matched
@@ -1129,25 +1173,23 @@ Add tooltips for definitions and morphology.  Also insert lemmas in buffer
       ;; morphology
       (when morph
 	(let ((matched nil))
-	  (cond ((string-match "robinson:.*" morph)    ; Robinson Greek morphology
-		 (setq matched (match-string 0 morph)))
-		((string-match "packard:.*" morph)     ; Packard Greek morphology --- LXX seems to use this
-		 (setq matched (match-string 0 morph)))
-		((string-match "oshm:.*" morph)        ; OSHM Hebrew morphology
-		 (setq matched (match-string 0 morph)))
-		(t nil
-		   ;;(message "Unknown morphology %s" morph)
-		   ))
+	  (if (or
+	       (string-match "robinson:.*" morph)	; Robinson Greek morphology
+	       (string-match "packard:.*" morph)	; Packard Greek morphology --- LXX seems to use this
+	       (string-match "oshm:.*" morph))		; OSHM Hebrew morphology
+	      (setq matched (match-string 0 morph))
+	    ;;(message "Unknown morphology %s" morph)
+	    )
 	  (when matched
 	    (setq bible-has-morphology t)
 	    (put-text-property refstart refend 'morph matched)
 	    (put-text-property refstart refend 'help-echo 'bible--show-lex-morph))))
 
-      ;; Insert lemma into buffer. Lemma tag will be part of savlm item.
-      ;; XXX Should I do lexicon lookups on these lemmas? I don't use
+      ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
+      ;; XXX Should I enable lexicon lookups on these lemmas? I don't use
       ;; this anyway....
-      (when (and bible-word-study-enabled savlm (string-match "lemma.*:.*" savlm))
-	(dolist (word (split-string (match-string 0 savlm) " "))
+      (when (and bible-word-study-enabled lemma (string-match "lemma.*:.*" lemma))
+	(dolist (word (split-string (match-string 0 lemma) " "))
 	  (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
 	  (insert " " word)
 	  (let ((refstart (- (point) 1 (length word)))
@@ -1189,9 +1231,15 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	  ((consp subnode)
 	   (let ((tag (dom-tag subnode)))
 	     (pcase tag
-		 ;; Maybe process these at some point? Include footnotes etc.
-		 ;; ('node nil)
-		 ;; ('lb nil)
+	       ;; Maybe process these at some point? Include footnotes etc.
+	       ;; ('node nil)
+	       ;; ('lb nil)
+	       ;; 'w --- Usual case.
+	       ('w (insert " ") (bible--process-word subnode iproperties))
+	       ;; 'q is used for red letter.
+	       ;; NASB Module uses 'seg to indicate OT quotations (and others?).
+	       ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties notitle))
+	       ('title (when (not notitle) (setq bible-chapter-title subnode) (bible-new-line)))
 	       ;; These tags appear in ESV modules (and maybe others?) XXX still not right
 	       ('l
 		(let ((attributes (dom-attributes subnode)))
@@ -1202,14 +1250,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 			((assoc 'level attributes)
 			 (let ((indent (string-to-number (alist-get 'level attributes))))
 			   (when (= indent 2) (insert "\n\t")))))))
-	       ('title (when (not notitle) (setq bible-chapter-title subnode) (bible-new-line)))
-	       ('body (bible--insert-domnode-recursive subnode iproperties notitle))
-	       ;; NASB Module uses this to indicate OT quotations (and others?).
-	       ('seg (bible--insert-domnode-recursive subnode iproperties notitle))
 	       ('divinename (bible-handle-divine-name subnode))
-	       ;; This tag is used for red letter.
-	       ((or 'p 'q) (bible--insert-domnode-recursive subnode iproperties notitle))
-	       ('w (insert " ") (bible--process-word subnode iproperties))
 	       ;; Some modules use this for line breaks and such.
 	       ('milestone (when (equal (dom-attr subnode 'type) "line") (bible-new-line)))
 	       ('div (when (equal (dom-attr subnode 'type) "paragraph") (bible-new-line)))
@@ -1266,8 +1307,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	      (refstart (point-min))
 	      refend)
 	  ;; Insert and make bold the title.
-;;;;      (when (string-or-null-p title-text)    ;;; XXXX Maybe wrong
-	  (when (stringp title-text) ;;; XXXX Maybe wrong	
+	  (when (stringp title-text)
 	    (insert title-text "\n")
 	    (setq refend (point))
 	    (put-text-property refstart refend 'face 'bold))))
@@ -1297,7 +1337,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 
   ;; If optional verse specification go to that verse.
   (when verse
-    (re-search-forward (regexp-opt `(,(concat (number-to-string verse) ":"))))))
+    (re-search-forward (regexp-opt `(,(concat (number-to-string verse) ":"))) nil t)))
 
 
 (defun bible--list-biblical-modules ()
@@ -1381,13 +1421,15 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
       (when match
 	(push
 	 ;; Massage match to make it more sortable, get rid of some characters.
-	 (replace-regexp-in-string
+	 (string-replace 
 	  "I " "1"
-	  (replace-regexp-in-string
+	  (string-replace
 	   "II " "2"
-	   (replace-regexp-in-string
+	   (string-replace
 	    "III " "3"
-	    (replace-regexp-in-string ".+; " "" matchstr))))
+	    (string-replace
+	     ".+; " "" 
+	     matchstr))))
 	 verses)))
 
     (setq match 0)
@@ -1412,17 +1454,16 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
       (setq mode-name (concat mode-name ")"))
       (goto-char (point-min)))))
 
-;;;;; Terms
+;;;;; Terms (lemmas, morphology)
 
 
 ;;(defun bible-display-morphology (morph)
 ;; ;; xxx Do something here?
 ;;  )
 
-(defun bible--display-term (termtype)
-  "Display a term of language given by TERMTYPE."
+(defun bible--fixup-lexicon-display (termtype)
+  "Fixup the display of a lexical entry whose language is given by TERMTYPE."
   (let ((buffer-read-only nil))
-
     (goto-char (point-min))
     ;; This enables clicking on Strong's numbers in some lexicon definitions.
     (while (search-forward-regexp "[0-9]+" nil t)
@@ -1454,45 +1495,38 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
   "Open a buffer of the Strong's Hebrew TERM's definition."
   (with-current-buffer (get-buffer-create (concat "*bible-term-hebrew-" term "*"))
     (bible-term-hebrew-mode)
-    (bible--display-term-hebrew term)
-    (pop-to-buffer (current-buffer) nil t)
-    (fit-window-to-buffer)))
-
-(defun bible--open-term-greek (term)
-  "Open a buffer of the Strong's Greek TERM definition."
-  (with-current-buffer (get-buffer-create (concat "*bible-term-greek-" term "*"))
-    (bible-term-greek-mode)
-    (bible--display-term-greek term)
+    (bible--display-lemma-hebrew term)
     (pop-to-buffer (current-buffer) nil t)
     (fit-window-to-buffer)))
 
-;;;
 ;;; Note: Hebrew display of terms is backwards; set bidi direction to
 ;;; 'left-to-right.
-(defun bible--display-term-hebrew (term)
-  "Render the definition of the Strong's Hebrew TERM.
+(defun bible--display-lemma-hebrew (lemma)
+  "Render the definition of the Strong's Hebrew LEMMA.
 Sets the variable `bidi-paragraph-direction' so the English text will
-render left-to-right. XXX Why doesn't this work for the tooltips?"
+render left-to-right. This code is customized for the BDBGlosses_Strongs
+lexicon."
   (let ((buffer-read-only nil))
     (erase-buffer)
-    (insert (replace-regexp-in-string
-	     (regexp-opt `(,bible-hebrew-lexicon))
-	     ""
-	     (bible--exec-diatheke term nil "plain" bible-hebrew-lexicon)
-	     nil nil nil 7))
-    (bible--display-term 'hebrew)
-    (setq bidi-paragraph-direction 'left-to-right)))
+    ;; BDBGlosses_Strongs needs the prefixed `H'.
+    (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew (concat "H" lemma))) 7))
+    (bible--fixup-lexicon-display 'hebrew)))
+
 
+(defun bible--open-term-greek (term)
+  "Open a buffer of the Strong's Greek TERM definition."
+  (with-current-buffer (get-buffer-create (concat "*bible-term-greek-" term "*"))
+    (bible-term-greek-mode)
+    (bible--display-lemma-greek term)
+    (pop-to-buffer (current-buffer) nil t)
+    (fit-window-to-buffer)))
 
-(defun bible--display-term-greek (term)
-  "Render the definition of the Strong's Greek TERM."
+(defun bible--display-lemma-greek (lemma)
+  "Render the definition of the Strong's Greek LEMMA."
   (let ((buffer-read-only nil))
     (erase-buffer)
-    (insert (replace-regexp-in-string
-	     (regexp-opt `(,bible-greek-lexicon))
-	     ""
-	     (bible--lookup-lex-greek term)))
-    (bible--display-term 'greek)))
+    (insert (bible--lookup-lemma-greek lemma))
+    (bible--fixup-lexicon-display 'greek)))
 
 
 (defun bible--set-location (book chapter &optional verse)