Tooltips, lexicons work

bible-mode.el

@@ -1,7 +1,7 @@
 ;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
 ;;
 ;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI
-;; Time-stamp: <2024-05-15 19:32:59 fred>
+;; Time-stamp: <2024-05-22 09:00:30 fred>
 
 ;; Author: Zacalot
 ;; Fixes and modifications by Fred Gilham
@@ -86,6 +86,8 @@
   :local t
   :group 'bible-mode)
 
+;;;
+;;; XXX Not implememted yet
 (defcustom bm-font
   "Ezra SIL"
   "Default font for bible-mode."
@@ -101,6 +103,17 @@
   :local nil
   :group 'bible-mode)
 
+
+;; This determines whether or not to use the Abbott Smith lexicon.
+;; There is special-case code for this.
+(defcustom bm-use-abbott
+  t
+  "Use the Abbott Smith `Manual Greek Lexicon' for Greek definitions."
+  :type 'boolean
+  :local nil
+  :group 'bible-mode)
+
+
 (defcustom bm-short-greek-lexicon
   "StrongsRealGreek"
   "Lexicon used for displaying definitions of Greek words in tooltips."
@@ -109,14 +122,14 @@
   :group 'bible-mode)
 
 (defcustom bm-hebrew-lexicon
-  "StrongsRealHebrew"  ; Nice to use BDBGlosses_Strongs but it needs to be special-cased
+  "StrongsRealHebrew"
   "Lexicon used for displaying definitions of Hebrew words using Strong's codes."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
   :group 'bible-mode)
 
 (defcustom bm-short-hebrew-lexicon
-  "StrongsRealHebrew"
+  "BDBGlosses_Strongs" ; This seems to work
   "Lexicon used for displaying definitions of Hebrew words in tooltips."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
@@ -139,7 +152,13 @@
 
 ;;; defvars
 
-(defvar bm-modules (lazy-completion-table bm-modules bm-list-biblical-modules))
+;;(defvar bm-verse-regexp "([\d ]*[a-zA-Z]+( \d*:\d*)?)(( - )| )?(((\d* )?[a-zA-Z]+ )?\d*([:-]+\d*)?)")
+;; (defvar bm-verse-regexp "/(\d*)\s*([a-z]+)\s*(\d+)(?::(\d+))?(\s*-\s*(\d+)(?:\s*([a-z]+)\s*(\d+))?(?::(\d+))?)?/i")
+(defvar bm-verse-regexp "\\(I?I \\)*[a-zA-Z]* [0-9]*:[0-9]*")
+(setq bm-verse-regexp "\\(I?I \\)*[a-zA-Z]* [0-9]*:[0-9]*")
+
+
+(defvar bm-modules (lazy-completion-table bm-modules bm--list-biblical-modules))
 
 ;; XXX I believe these chapter counts aren't the same for all modules, e.g. JPS.
 (defvar bm-books
@@ -164,6 +183,28 @@
     ("III John"		. 1)    ("Jude"			. 1)	("Revelation of John"	. 22))
   "A-list of name / chapter count for Bible books.")
 
+(defvar bm-book-name-abbreviations-alist
+  '(;; Old Testament
+    ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
+    ("De"     . "Deuteronomy")     ("Js"    . "Joshua")           ("Jg"   . "Judges")        ("Ru"    . "Ruth")
+    ("I Sa"   . "I Samuel")        ("II Sa" . "II Samuel")        ("I Ki" . "I Kings")       ("II Ki" . "II Kings") 
+    ("I Ch"   . "I Chronicles")    ("II Ch" . "II Chronicles")    ("Ezr"  . "Ezra")          ("Ne"    . "Nehemiah")
+    ("Es"     . "Esther")          ("Jb"    . "Job")              ("Ps"   . "Psalms")        ("Pr"    . "Proverbs")
+    ("Ec"     . "Ecclesiastes")    ("So"    . "Song of Solomon")  ("Is"   . "Isaiah")        ("Je"    . "Jeremiah")
+    ("La"     . "Lamentations")    ("Ez"    . "Ezekiel")          ("Da"   . "Daniel")        ("Ho"    . "Hosea") 
+    ("Joe"    . "Joel")	           ("Am"    . "Amos")             ("Ob"   . "Obadiah")       ("Jon"   . "Jonah")
+    ("Mi"     . "Micah")           ("Na"    . "Nahum")            ("Ha"   . "Habakkuk")      ("Zep"   . "Zephaniah")     
+    ("Hag"    . "Haggai")          ("Ze"    . "Zechariah")        ("Mal"  . "Malachi")
+    ;; New Testament
+    ("Mt"     . "Matthew")         ("Mk"    . "Mark")             ("Lk"   . "Luke")          ("Jo"    . "John")
+    ("Ac"     . "Acts")            ("Ro"    . "Romans")           ("I Co" . "I Corinthians") ("II Co" . "II Corinthians")
+    ("Ga"     . "Galatians")       ("Eph"   . "Ephesians")	  ("Phl"  . "Philippians")   ("Col"   . "Colossians")
+    ("I Th"   . "I Thessalonians") ("II Th" . "II Thessalonians") ("I Ti" . "I Timothy")     ("II Ti" . "II Timothy")
+    ("Tit"    . "Titus")           ("Phm"   . "Philemon")	  ("He"   . "Hebrews")       ("Ja"    . "James")
+    ("I Pe"   . "I Peter")         ("II Pe" . "II Peter")	  ("I Jo" . "I John")        ("II Jo" . "II John")
+    ("III Jo" . "III John")        ("Ju"    . "Jude")             ("Re"   . "Revelation of John"))
+  "A-list of abbreviations for Bible books.")
+
 ;;;; Book / chapter
 
 (defvar-local bm-current-book (assoc "Genesis" bm-books)
@@ -217,47 +258,49 @@
 (define-key bible-search-mode-map "s" 'bible-search)
 (define-key bible-search-mode-map "w" 'bm-toggle-word-study)
 (define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
+(define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
 (defconst bible-term-hebrew-mode-map (make-keymap))
 (defconst bible-term-greek-mode-map (make-keymap))
-(defconst bible-term-morph-mode-map (make-keymap))
-
+;; (defconst bible-term-morph-mode-map (make-keymap))
 
 ;;;
 ;;; Menu bar items
 ;;;
-;;; Right now just convenience items. More as I think of them.
-;;;
+
 (define-key global-map [menu-bar bible-mode]
 	    (cons "Bible Mode" (make-sparse-keymap "Bible Mode")))
 
-(defun bm-set-left-to-right ()
+(defun bible-set-left-to-right ()
   (interactive)
   (setq-local bidi-paragraph-direction 'left-to-right))
 
-(defun bm-set-right-to-left ()
+(defun bible-set-right-to-left ()
   (interactive)
   (setq-local bidi-paragraph-direction 'right-to-left))
 
 (define-key global-map
 	    [menu-bar bible-mode left-to-right]
-	    '("Left-to-right" . bm-set-left-to-right))
+	    '("Left-to-right" . bible-set-left-to-right))
 
 (define-key global-map 
 	    [menu-bar bible-mode right-to-left]
-	    '("Right-to-left" . bm-set-right-to-left))
+	    '("Right-to-left" . bible-set-right-to-left))
 
-(defvar-local bm-debugme nil)
+(defvar-local bm-debugme nil
+  "Make text show up as XML when set.")
 
-(defun bm-set-display-xml ()
+(defun bible-set-display-xml ()
+  "Turn on XML display."
   (interactive)
   (setq-local bm-debugme t)
-  (bm-display))
+  (bm--display))
 
 (defun bm-set-display-text ()
+  "Turn off XML display."
   (interactive)
   (setq-local bm-debugme nil)
-  (bm-display))
+  (bm--display))
 
 
 (define-key global-map 
@@ -271,11 +314,16 @@
 
 (define-key global-map
 	    [menu-bar bible-mode select-biblical-text]
-	    '("Select Module" . bm-display-available-modules))
+	    '("Select Module" . bm--display-available-modules))
 
 
+(define-key global-map
+	    [menu-bar bible-mode select-biblical-text]
+	    '("Toggle debug-on-error" . toggle-debug-on-error))
+
 
 (defun bm-display-greek ()
+  "This command is run by clicking on text, not directly by the user."
   (interactive)
   (let ((item (car (split-string (get-text-property (point) 'strong)))))
     ;; Remove "strong:G" prefix
@@ -286,10 +334,11 @@
 (define-key bm-greek-keymap [mouse-1] 'bm-display-greek)
 
 (defun bm-display-hebrew () 
+  "This command is run by clicking on text, not directly by the user."
   (interactive)
   (let ((item (car (split-string (get-text-property (point) 'strong)))))
     ;; Remove "strong:H" prefix and any alphabetic suffixes.
-    (bible-term-hebrew (replace-regexp-in-string "[a-zA-Z]" "" item nil nil nil 8))))
+    (bible-term-hebrew (replace-regexp-in-string "strong:H" "" item))))
 
 (defconst bm-hebrew-keymap (make-sparse-keymap))
 (define-key bm-hebrew-keymap (kbd "RET") 'bm-display-hebrew)
@@ -346,7 +395,7 @@
 \\{bible-term-greek-mode-map}"
   (buffer-disable-undo)
   (font-lock-mode t)
-  (use-local-map bible-term-greek-mode-map)
+;;  (use-local-map bible-term-greek-mode-map)
   (setq buffer-read-only t)
   (visual-line-mode t))
 
@@ -367,7 +416,7 @@
   (let ((buf (get-buffer-create (generate-new-buffer-name (concat "*bible*")))))
     (set-buffer buf)
     (bible-mode)
-    (bm-set-location (assoc (or book-name "Genesis") bm-books) (or chapter 1) verse)
+    (bm--set-location (assoc (or book-name "Genesis") bm-books) (or chapter 1) verse)
     (set-window-buffer (get-buffer-window (current-buffer)) buf)))
 
 ;;;###autoload
@@ -376,13 +425,13 @@
   (interactive)
   (let* ((book-chapters (cdr bm-current-book))
 	 (chapter (min book-chapters (+ bm-current-chapter 1))))
-    (bm-set-location bm-current-book chapter)))
+    (bm--set-location bm-current-book chapter)))
 
 ;;;###autoload
 (defun bm-previous-chapter ()
   "Pages to the previous chapter for the active `bible-mode' buffer."
   (interactive)
-  (bm-set-location bm-current-book (max 1 (- bm-current-chapter 1))))
+  (bm--set-location bm-current-book (max 1 (- bm-current-chapter 1))))
 
 
 (defun bm-forward-word ()
@@ -400,11 +449,11 @@ XXX Doesn't work yet."
   (interactive)
   (let* ((completion-ignore-case t)
 	 (book-data (assoc (completing-read "Book: " bm-books nil t) bm-books))
-         (chapter (string-to-number (completing-read "Chapter: " (bm-list-number-range 1 (cdr book-data)) nil t))))
+         (chapter (string-to-number (completing-read "Chapter: " (bm--list-number-range 1 (cdr book-data)) nil t))))
     (setq-local bm-current-book book-data)
     (setq-local bm-current-book-name (car book-data))
     (setq-local bm-current-chapter chapter)
-    (bm-display)))
+    (bm--display)))
 
 
 ;;;###autoload
@@ -412,9 +461,9 @@ XXX Doesn't work yet."
   "Queries user to select a new chapter for the current `bible-mode' buffer."
   (interactive)
   (let* ((book-chapters (cdr bm-current-book))
-	 (chapter (string-to-number (completing-read "Chapter: " (bm-list-number-range 1 book-chapters) nil t))))
+	 (chapter (string-to-number (completing-read "Chapter: " (bm--list-number-range 1 book-chapters) nil t))))
     (when chapter
-      (bm-set-location bm-current-book chapter))))
+      (bm--set-location bm-current-book chapter))))
 
 ;;;###autoload
 (defun bm-select-module ()
@@ -422,7 +471,7 @@ XXX Doesn't work yet."
   (interactive)
   (let ((module (completing-read "Module: " bm-modules)))
     (setq-local bm-module module)
-    (bm-display)))
+    (bm--display)))
 
 ;;;###autoload
 (defun bm-toggle-word-study()
@@ -430,8 +479,8 @@ XXX Doesn't work yet."
   (interactive)
   (setq bm-word-study-enabled (not bm-word-study-enabled))
   (if (equal major-mode 'bible-search-mode)
-      (bm-display-search bm-search-query bm-search-mode bm-module)
-    (bm-display)))
+      (bm--display-search bm-search-query bm-search-mode bm-module)
+    (bm--display)))
 
 ;;;###autoload
 (defun bm-split-display ()
@@ -451,7 +500,7 @@ search."
   (interactive "sBible Search: ")
   (when (> (length query) 0)
     (let* ((searchmode (completing-read "Search Mode: " '("lucene" "phrase") nil t "lucene")))
-      (bm-open-search query searchmode))))
+      (bm--open-search query searchmode))))
 
 ;;;###autoload
 (defun bible-search-mode-follow-verse ()
@@ -469,26 +518,45 @@ creating a new `bible-mode' buffer positioned at the specified verse."
     (string-match ":[0-9]?[0-9]?[0-9]?" text)
     (setq verse (replace-regexp-in-string "[^0-9]" "" (match-string 0 text)))
     (setq book (replace-regexp-in-string "[ ][0-9]?[0-9]?[0-9]?:[0-9]?[0-9]?[0-9]?:$" "" text))
-    (bible-open book (string-to-number chapter) (string-to-number verse))))
+    (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
+
+(defun bible-search-mode-follow-xref ()
+  "Follows the hovered verse in a `bible-search-mode' buffer,
+creating a new `bible-mode' buffer positioned at the specified verse.
+N.B. We use the default module to avoid opening cans of worms regarding
+OT/NT etc."
+  (interactive)
+  (let* ((xref (get-text-property (point) 'xref))
+	 (verse-ref (string-split xref))
+	 book-abbrev
+	 book
+	 chapter-verse
+	 chapter
+	 verse)
+    (if (= (length verse-ref) 3) ; II Cor 3:17 or the like
+	(progn
+	  (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref)))
+	  (setq chapter-verse (split-string (caddr verse-ref) ":")))
+      (progn  ; Mat 5 or the like
+	(setq book-abbrev (car verse-ref))
+	(setq chapter-verse (split-string (cadr verse-ref) ":"))))
+
+    (setq book (cdr (assoc book-abbrev bm-book-name-abbreviations-alist)))
+    (setq chapter (car chapter-verse)
+	  verse (cadr chapter-verse))
+    (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
 
 ;;;###autoload
 (defun bible-term-hebrew (term)
   "Queries user for a Strong's Hebrew Lexicon term."
   (interactive "sTerm: ")
-  (bm-open-term-hebrew term))
+  (bm--open-term-hebrew term))
 
 ;;;###autoload
 (defun bible-term-greek (term)
   "Queries user for a Strong's Greek Lexicon term."
   (interactive "sTerm: ")
-  (bm-open-term-greek term))
-
-;; (defun bible-term-morph (term morph-type)
-;;   "Queries user for a Strong's Greek Lexicon term."
-;;   (interactive "sTerm: ")
-;; ;;;  (message "bible-term-morph: %s:%s" term morph-type)
-;; ;;;  (bm-open-term-greek term)
-;;   )
+  (bm--open-term-greek term))
 
 ;;;###autoload
 (defun bible-insert ()
@@ -496,21 +564,21 @@ creating a new `bible-mode' buffer positioned at the specified verse."
   (interactive)
   (let* ((completion-ignore-case t)
 	 (book-data (assoc (completing-read "Book: " bm-books nil t) bm-books))
-         (chapter (when book-data (completing-read "Chapter: " (bm-list-number-range 1 (cdr book-data)) nil t)))
+         (chapter (when book-data (completing-read "Chapter: " (bm--list-number-range 1 (cdr book-data)) nil t)))
          (verse (when chapter (read-from-minibuffer "Verse: "))))
     (when verse
       (insert (string-trim
 	       (replace-regexp-in-string 
 		(regexp-opt `(,(concat "(" bm-module ")")))
 		"" 
-		(bm-exec-diatheke (concat (car book-data) " " chapter ":" verse) nil "plain")))))))
+		(bm--exec-diatheke (concat (car book-data) " " chapter ":" verse) nil "plain")))))))
 
 ;;;;; Support
 
 ;;;
 ;;; XXX I've magled this in an ad-hoc manner. It needs to be
 ;;; re-written so it is clearer (and correct, for that matter).
-(defun bm-exec-diatheke (query &optional filter format searchtype module)
+(defun bm--exec-diatheke (query &optional filter format searchtype module)
   "Executes `diatheke' with specified query options, returning the output."
   (let ((module (or module bm-module)))
     (with-temp-buffer
@@ -535,101 +603,179 @@ like `Of David' or the like.")
 ;;; Greek and Hebrew lexicon and morphology tooltip rendering.
 ;;;
 
-;;; Hash tables for STRONGS definitions.
+;;; Hash tables for Lexical definitions.
 (defvar greek-hash (make-hash-table :test 'equal))
+(defvar greek-short-hash (make-hash-table :test 'equal))  ; Hash table for ``short'' lexical lookup
 (defvar hebrew-hash (make-hash-table :test 'equal))
+(defvar hebrew-short-hash (make-hash-table :test 'equal))
+
+;; Do lookups using AbbottSmith_Strongs as index to AbbottSmith lexicon.
+(defvar abbott-index-hash (make-hash-table :test 'equal))
+(defvar abbott-lex-hash (make-hash-table :test 'equal)) 
 
-;;; Hash tables for morphologies. Three at present.
+;;; Hash tables for Morphologies. Three at present.
 (defvar robinson-hash (make-hash-table :test 'equal))
 (defvar packard-hash (make-hash-table :test 'equal))
 (defvar oshm-hash (make-hash-table :test 'equal))
 
 ;;; Use HTMLHREF format with diatheke, post-process to render html.
-(defun bm-morph-query (query module)
+(defun bm--morph-query (query module)
   "Executes `diatheke' to do morph query, renders HTML, returns string.
 Does some tweaking specific to morphology."
   (with-temp-buffer
     (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
       (apply 'call-process args)
       (shr-render-region (point-min) (point-max))
-      (replace-regexp-in-string
-       "\n:" ""                   ; This makes the Packard morphology display look better.
-       (replace-regexp-in-string 
-	"Part of Speech" ""       ; This helps the Robinson display look better.
-	(substring (buffer-string) (+ (length query) 1)) ; This tries to get rid of unnecessary query identifier.
-	)))))
+      (format-replace-strings 
+       '(("\n:" . "")              ; This makes the Packard morphology display look better.
+	 ("Part of Speech" . ""))     ; This helps the Robinson display look better.
+	 nil (point-min) (point-max))
+      (substring (buffer-string) (+ (length query) 1))) ; This tries to get rid of unnecessary query identifier.
+    ))
 
 
 ;;; Use "plain" format with diatheke.
-(defun bm-lex-query (query module)
+(defun bm--lex-query (query module)
   "Executes `diatheke' for query, plain format, returns string."
   ;; Get rid of query ID at front of string: ?????:
-  (bm-exec-diatheke query nil "plain" nil module))
+  (bm--exec-diatheke query nil "plain" nil module))
+
 
-(defun bm-lookup-strongs-greek (window object pos)
+(defun bm--lookup-strongs-greek (window object pos)
   "Look up Greek lexical data for object at point. If not found in hash table,
-get it from sword database, stash in hash table, and return data.
-Note: compiler warns about unused argument `window'."
+get it from sword database, stash in hash table, and return data."
   (let* ((query (get-text-property pos 'strong object))
-	 (match (string-match "[0-9]+" query))           ; Compiler warns about match.
+	 (match (string-match "[0-9]+" query))
 	 (lookup-key (match-string 0 query)))
     (and lookup-key
 	 (or (gethash lookup-key greek-hash)
-	     (puthash lookup-key (bm-lex-query lookup-key bm-short-greek-lexicon) greek-hash)))))
+	     (puthash lookup-key (bm--lex-query lookup-key bible-mode-short-greek-lexicon) greek-hash)))))
+
+
+(defun bm--lookup-lemma-abbott (key)
+  "Given a strong's number, return the Greek lemma from AbbottSmithStrongs."
+  (or (gethash key abbott-index-hash)
+      (puthash key 
+	       (string-trim 
+		(replace-regexp-in-string
+		 "(AbbottSmithStrongs)" "" 
+		 (bm--lex-query key "AbbottSmithStrongs")))
+	       abbott-index-hash)))
+
+
+(defun bm--lookup-def-abbott (lemma)
+  "Executes `diatheke' to do abbott query, renders HTML, sets text
+properties to allow verse cross references. Returns string."
+  (with-temp-buffer
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" "AbbottSmith" "-o" "m" "-f" "plain" "-k" lemma)))
+      (apply 'call-process args)
+      (format-replace-strings
+       '((" I." . "\n    I.")
+	 (" 1." . "\n    1.")
+	 ("      (a)" . "\n       (a)")
+	 (". ." . ".")
+	 (" . " . ". ")))
+      (goto-char (point-min))
+      (while (search-forward-regexp bm-verse-regexp nil t)
+	(put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
+	(put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
+	(add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue"))
+	))
+    (buffer-string)))
+
+(defun bm--lookup-lex-def-abbott (key)
+  (let* ((abbott-lemma (bm--lookup-lemma-abbott key))
+	 ;; Get the lemma which is after the `@LINK' string.
+	 (lemma (caddr (split-string abbott-lemma)))
+	 ;; Use the lemma to lookup the definition.
+	 (lex-def (bm--lookup-def-abbott lemma)))
+    lex-def))
+
+
+(defun bm--lookup-strongs-greek-abbott (window object pos)
+  "To use Abbott's Lexicon we extract the Strong's key from the text in the
+buffer. Given the Strong's number, get the lemma for that number. Use
+that lemma to lookup the definition in the AbbottStrongs lexicon.
+
+Compiler warns about unused Window argument."
+  (let* ((query (get-text-property pos 'strong object))
+	 (match (string-match "[0-9]+" query)) ; Compiler warns about unused match variable.
+	 (lookup-key (match-string 0 query)))
+    (when lookup-key
+      (bm--lookup-lex-def-abbott lookup-key))))
 
 
-(defun bm-hebrew-lex-query (query module)
-  "Executes `diatheke' to do hebrew query, renders HTML, returns string."
+
+;;; Not used.
+(defun bm--hebrew-lex-query (query module)
+  "Executes `diatheke' to do hebrew query, renders HTML, returns string. 
+XXX directionality problems."
   (with-temp-buffer
     (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
       (apply 'call-process args)
       (shr-render-region (point-min) (point-max)))))
 
-(defun bm-lookup-strongs-hebrew (window object pos)
+(defun bm--lookup-strongs-hebrew (window object pos)
   "Look up Hebrew lexical data for object at point. If not found in hash table,
 get it from sword database, stash in hash table, and return data.
 Note: compiler warns about unused `window' argument."
   (let* ((query (get-text-property pos 'strong object))
 	 (match (string-match "[0-9]+" query))         ; Compiler warns about match.
-	 (lookup-key (match-string 0 query)))
-    (and lookup-key
-	 (or (gethash lookup-key hebrew-hash)
-	     ;; Use PLAIN format for lookup. XXX directionality problems.
-	     (puthash lookup-key (bm-lex-query lookup-key bm-short-hebrew-lexicon) hebrew-hash)))))
-
-(defun bm-morph-database-lookup (query database hash)
+	 (match-string (match-string 0 query)))
+    (when match-string
+      (let ((lookup-key (concat "H" (match-string 0 query))))
+	(or (gethash lookup-key hebrew-hash)
+	    ;; Use PLAIN format for lookup. XXX directionality problems.
+	    (let ((raw-text (bm--lex-query lookup-key bm-short-hebrew-lexicon)))
+	      ;; XXX massage this text to handle outline formatting a bit better.
+	      (puthash lookup-key raw-text hebrew-hash)))))))
+
+(defun bm--morph-database-lookup (query database hash)
   (or (gethash query hash)
-      (puthash query (bm-morph-query query database) hash)))
-
+      (puthash query (bm--morph-query query database) hash)))
 
-(defun bm-show-lex-morph (window object pos)
+;;;
+;;; Get string for tooltip display
+;;;
+(defun bm--show-lex-morph (window object pos)
   (let* ((lex-morph-text "")
 	 (lex (get-text-property pos 'strong object))
+	 (lex-module nil)
 	 (lex-text
 	  (cond ((string-match "strong:G" lex)
-	   	 (bm-lookup-strongs-greek window object pos))
+		 (setq lex-module bm-short-greek-lexicon)
+	   	 (bm--lookup-strongs-greek window object pos))
 		((string-match "strong:H" lex)
-		 (bm-lookup-strongs-hebrew window object pos)))))
+		 (setq lex-module bm-short-hebrew-lexicon)
+		 (bm--lookup-strongs-hebrew window object pos)))))
+    (setq lex-text (string-replace (concat "(" lex-module ")") "" lex-text))
     (let* ((morph (get-text-property pos 'morph object))
+	   (morph-module nil)
 	   (morph-text
-	    (cond ((null morph) "")
+	    (cond ((null morph) nil)
 		  ((string-match "robinson:" morph)
-	   	   (bm-morph-database-lookup (replace-regexp-in-string "robinson:" "" morph) "Robinson" robinson-hash))
+		   (setq morph-module "Robinson")
+	   	   (bm--morph-database-lookup (replace-regexp-in-string "robinson:" "" morph) morph-module robinson-hash))
 		  ((string-match "packard:" morph)
-		   (bm-morph-database-lookup (replace-regexp-in-string "packard:" "" morph) "Packard" packard-hash))
+		   (setq morph-module "Packard")
+		   (bm--morph-database-lookup (replace-regexp-in-string "packard:" "" morph) morph-module packard-hash))
 		  ((string-match "oshm:" morph)
-	   	   (bm-morph-database-lookup (replace-regexp-in-string "oshm:" "" morph) "OSHM" oshm-hash)))))
+		   (setq morph-module "OSHM")
+	   	   (bm--morph-database-lookup (replace-regexp-in-string "oshm:" "" morph) morph-module oshm-hash)))))
       (when lex-text
-	(setq lex-morph-text lex-text))
+	(setq lex-morph-text (string-trim (string-fill lex-text 75))))
       (when morph-text
-	(setq lex-morph-text (concat lex-morph-text "\n" morph-text)))
+	(setq lex-morph-text 
+	      (concat lex-morph-text "\n\n"
+		      (string-trim (string-replace (concat "(" morph-module ")") "" morph-text)))))
       ;; This prevents bogus command substitutions in the tooltip by
-      ;; removing backslashes.
-      (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text))
-      lex-morph-text)))
+      ;; removing backslashes. XXX I couldn't figure out a better way
+      ;; to bypass command substitution in the tooltips.
+      (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text)))))
 
 
-(defun bm-process-word (item iproperties)
+
+(defun bm--process-word (item iproperties)
   "Word study. Add tooltips for definitions and morphologyl. 
 Insert lemmas in buffer. Must be done after item is inserted in buffer."
 
@@ -657,7 +803,7 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
 	  (let ((strongs-ref (match-string 0 strongs)))
 	    (add-face-text-property refstart refend 'bold)
       	    (put-text-property refstart refend 'keymap bm-hebrew-keymap)
-	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph)
+	    (put-text-property refstart refend 'help-echo 'bm--show-lex-morph)
 	    (put-text-property refstart refend 'strong strongs-ref))))
 
       ;; lexical definitions
@@ -672,7 +818,7 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
 	  ;; Add help-echo, strongs reference for tooltips if match.
 	  (when matched
 	    (setq-local bm-has-strongs t)
-	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph)
+	    (put-text-property refstart refend 'help-echo 'bm--show-lex-morph)
 	    (put-text-property refstart refend 'strong matched))))
 
       ;; morphology
@@ -690,7 +836,7 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
 	  (when matched
 	    (setq-local bm-has-morphology t)
 	    (put-text-property refstart refend 'morph matched)
-	    (put-text-property refstart refend 'help-echo 'bm-show-lex-morph))))
+	    (put-text-property refstart refend 'help-echo 'bm--show-lex-morph))))
 
       ;; Insert lemma into buffer. Lemma tag will be part of savlm item.
       (when (and bm-word-study-enabled savlm (string-match "lemma.*:.*" savlm))
@@ -703,9 +849,9 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
 	    (put-text-property refstart refend 'keymap bm-lemma-keymap)))))))
 
 
-(defun bm-insert-domnode-recursive (node &optional iproperties notitle)
+(defun bm--insert-domnode-recursive (node &optional iproperties notitle)
   "Recursively parses a domnode from `libxml-parse-html-region's usage on text
-produced by `bm-exec-diatheke'. Outputs text to active buffer 
+produced by `bm--exec-diatheke'. Outputs text to active buffer 
 with properties.
 In processing subnodes, each case will prepend a space if it needs it."
 
@@ -724,23 +870,22 @@ In processing subnodes, each case will prepend a space if it needs it."
 	   ;; Insert the subnode. Highlight the verse references.
 	   (insert subnode)
 	   ;; XXX this is still not quite right
-	   (let ((verse-start (string-match ".+?:[0-9]?[0-9]?[0-9]?:" subnode)))
+	   (let ((verse-start (string-match bm-verse-regexp subnode)))
 	     (when verse-start
 	       (let* ((verse-match (string-trim (match-string 0 subnode)))
 		      (verse-start-text (string-trim-left (substring subnode verse-start (length subnode))))
-;;		      (subnode (concat (substring subnode 0 verse-start) verse-start-text))
 		      (start (- (point) 1 (length (string-trim-right verse-start-text)))))
 		 (add-face-text-property start (+ start (length (string-trim-right verse-match))) '(:foreground "purple"))))))
 	  ((eq (dom-tag subnode) 'title)
 	   (if notitle nil
 	     (progn
 	       (setq bm-chapter-title subnode))))
-	  ((eq (dom-tag subnode) 'body) (bm-insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'body) (bm--insert-domnode-recursive subnode iproperties notitle))
 	  ((eq (dom-tag subnode) 'seg) ; NASB Module uses this to indicate OT quotations (and others?).
-	   (bm-insert-domnode-recursive subnode iproperties notitle))
-	  ((eq (dom-tag subnode) 'q) (bm-insert-domnode-recursive subnode iproperties notitle))
-	  ((eq (dom-tag subnode) 'p) (bm-insert-domnode-recursive subnode iproperties notitle))
-	  ((eq (dom-tag subnode) 'w) (insert " ") (bm-process-word subnode iproperties))
+	   (bm--insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'q) (bm--insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'p) (bm--insert-domnode-recursive subnode iproperties notitle))
+	  ((eq (dom-tag subnode) 'w) (insert " ") (bm--process-word subnode iproperties))
 	  ((eq (dom-tag subnode) 'milestone) (insert "\n"))
 	  ((eq (dom-tag subnode) 'transchange) ; Word inserted by translation, not in original, give visual indication.
 	   (let ((word (dom-text subnode)))
@@ -751,16 +896,16 @@ In processing subnodes, each case will prepend a space if it needs it."
 (defvar bm-debugme nil)
 (setf bm-debugme nil)
 
-(defun bm-display (&optional verse)
+(defun bm--display (&optional verse)
   "Renders text for `bible-mode'"
 
-  ;; Clear buffer and insert the result of calling bm-exec-diatheke.
+  ;; Clear buffer and insert the result of calling bm--exec-diatheke.
   (setq buffer-read-only nil)
   (erase-buffer)
   (setq bm-chapter-title nil
 	bm-has-strongs nil
 	bm-has-morphology nil)
-  (insert (bm-exec-diatheke (concat bm-current-book-name ":" (number-to-string bm-current-chapter))))
+  (insert (bm--exec-diatheke (concat bm-current-book-name ":" (number-to-string bm-current-chapter))))
 
   ;; Parse the xml in the buffer into a DOM tree.
   (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
@@ -769,7 +914,7 @@ In processing subnodes, each case will prepend a space if it needs it."
 	(progn
 	  (erase-buffer)
 	  ;; Looking for the "body" tag in the DOM node.
-	  (bm-insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	  (bm--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
 	  (goto-char (point-min)))
 ;;;      (shr-render-region (point-min) (point-max))
       ))
@@ -809,9 +954,9 @@ In processing subnodes, each case will prepend a space if it needs it."
     (beginning-of-line)))
 
 
-(defun bm-list-biblical-modules ()
+(defun bm--list-biblical-modules ()
   "Returns a list of accessible Biblical Text modules."
-  (let ((text (bm-exec-diatheke "modulelist" nil nil nil "system"))
+  (let ((text (bm--exec-diatheke "modulelist" nil nil nil "system"))
 	modules)
     (catch 'done
       (dolist (line (split-string text "\n"))
@@ -823,7 +968,6 @@ In processing subnodes, each case will prepend a space if it needs it."
 
 (defun bm-pick-module ()
   (interactive)
-  (message "Picking module at %s" (point))
   (let ((item (get-text-property (point) 'module)))
     (setq-default bm-module item)
     (bible-open)))
@@ -836,7 +980,7 @@ In processing subnodes, each case will prepend a space if it needs it."
 (defun bm-display-available-modules ()
   (interactive)
   (let ((buf (get-buffer-create "Modules"))
-	(mods (bm-list-biblical-modules)))
+	(mods (bm--list-biblical-modules)))
     (set-buffer buf)
     (module-select-mode)
     (setq buffer-read-only nil)
@@ -855,28 +999,28 @@ In processing subnodes, each case will prepend a space if it needs it."
     (pop-to-buffer buf nil t)))
 
 
-
 ;;;;; Bible Searching
 
-(defun bm-open-search (query searchmode)
+(defun bm--open-search (query searchmode)
   "Opens a search buffer of QUERY using SEARCHMODE."
   (let ((buf (get-buffer-create (concat "*bible-search-" (downcase bm-module) "-" query "*"))))
     (set-buffer buf)
     (bible-search-mode)
-    (bm-display-search query searchmode bm-module)
+    (bm--display-search query searchmode bm-module)
     (pop-to-buffer buf nil t)))
 
-(defun bm-display-search (query searchmode mod)
+(defun bm--display-search (query searchmode mod)
   "Renders results of search QUERY from SEARHCMODE"
   (setq buffer-read-only nil)
   (erase-buffer)
   
   (let* ((result (string-trim (replace-regexp-in-string 
 			       "Entries .+?--" "" 
-			       (bm-exec-diatheke query nil "plain" searchmode mod))))
+			       (bm--exec-diatheke query nil "plain" searchmode mod))))
 	 (match 0)
 	 (matchstr "")
-	 (verses "")
+	 (verses nil)
+	 (query-verses "")
 	 fullverses)
     (if (equal result (concat "none (" bm-module ")"))
 	(insert "No results found." (when (equal searchmode "lucene") " Verify index has been build with mkfastmod."))
@@ -884,18 +1028,31 @@ In processing subnodes, each case will prepend a space if it needs it."
 	(while match
 	  (setq match (string-match ".+?:[0-9]?[0-9]?" result (+ match (length matchstr)))
 		matchstr (match-string 0 result))
+
 	  (when match
-            (setq verses (concat verses (replace-regexp-in-string ".+; " "" matchstr) ";"))))
+	    (push
+	     ;; Massage match to make it more sortable, get rid of
+	     ;; some characters.
+	     (replace-regexp-in-string 
+	      "I " "1"
+	      (replace-regexp-in-string
+	       "II " "2"
+	       (replace-regexp-in-string ".+; " "" matchstr)))
+	     verses)))
 
 	(setq match 0)
-	(setq fullverses (bm-exec-diatheke verses))
+	(setq verses (sort verses))
+	(dolist (verse verses)
+	  (if query-verses
+	      (setq query-verses (concat query-verses ";" verse))
+	    (setq query-verses verse)))
+	(setq fullverses (bm--exec-diatheke query-verses))
 
 	(insert fullverses)
-	(sort-lines nil (point-min) (point-max))
 	    
 	(let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
 	  (erase-buffer)
-	  (bm-insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	  (bm--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
 	  (goto-char (point-min))
 	  (while (search-forward (concat "(" bm-module ")") nil t)
 	    (replace-match "")))))
@@ -913,7 +1070,8 @@ In processing subnodes, each case will prepend a space if it needs it."
 ;; ;; xxx Do something here?
 ;;  )
 
-(defun bm-display-term (termtype)
+(defun bm--display-term (termtype)
+  (setq buffer-read-only nil)
   (cl-do* ((text (buffer-string))
            (match (string-match "[0-9]+" text) (string-match "[0-9]+" text (match-end 0))))
       ((not match))
@@ -922,43 +1080,45 @@ In processing subnodes, each case will prepend a space if it needs it."
            (refstart (+ match 1))
            (refend (+ match 1 matchstrlen)))
       ;; This enables clicking on the Strong's numbers inside the term display.
-      (add-face-text-property refstart refend `(:foreground "blue"))
       (cond ((eq termtype 'hebrew)
 	     (put-text-property refstart refend 'strong (concat "strong:H" matchstr))
-	     (put-text-property refstart refend 'keymap bm-hebrew-keymap))
-	    ((eq termtype 'greek)
+	     (put-text-property refstart refend 'keymap bm-hebrew-keymap)
+	     (add-face-text-property refstart refend `(:foreground "blue")))
+	    ((and (not bm-use-abbott) (eq termtype 'greek)) ; Abbott entries don't have Strong's numbers 
 	     (put-text-property refstart refend 'strong (concat "strong:G" matchstr))
-	     (put-text-property refstart refend 'keymap bm-greek-keymap)))))
+	     (put-text-property refstart refend 'keymap bm-greek-keymap)
+	     (add-face-text-property refstart refend `(:foreground "blue"))))))
+    
   (goto-char (point-min))
-  (while (search-forward (concat "(" bm-module ")") nil t)
-    (replace-match ""))
+;;  (while (search-forward (concat "(" bm-module ")") nil t)
+;;    (replace-match ""))
   (while (search-forward "()" nil t)
     (replace-match ""))
   (goto-char (point-min))
   (setq buffer-read-only t))
 
-(defun bm-open-term-hebrew (term)
+(defun bm--open-term-hebrew (term)
   "Opens a buffer of the Strong's Hebrew TERM's definition"
   (let ((buf (get-buffer-create (concat "*bible-term-hebrew-" term "*"))))
     (set-buffer buf)
     (bible-term-hebrew-mode)
-    (bm-display-term-hebrew term)
+    (bm--display-term-hebrew term)
     (pop-to-buffer buf nil t)
     (fit-window-to-buffer)))
 
-(defun bm-open-term-greek (term)
+(defun bm--open-term-greek (term)
   "Opens a buffer of the Strong's Greek TERM's definition"
   (let ((buf (get-buffer-create (concat "*bible-term-greek-" term "*"))))
     (set-buffer buf)
     (bible-term-greek-mode)
-    (bm-display-term-greek term)
+    (bm--display-term-greek term)
     (pop-to-buffer buf nil t)
     (fit-window-to-buffer)))
 
 ;;;
 ;;; Note: Hebrew display of terms is backwards; set bidi direction to
 ;;; 'left-to-right.
-(defun bm-display-term-hebrew (term)
+(defun bm--display-term-hebrew (term)
   "Render the definition of the Strong's Hebrew TERM. Use
 bidi-paragraph-direction so the English text will render
 left-to-right. XXX Why doesn't this work for the tooltips?"
@@ -967,37 +1127,38 @@ left-to-right. XXX Why doesn't this work for the tooltips?"
   (insert (replace-regexp-in-string
 	   (regexp-opt `(,bm-hebrew-lexicon))
 	   ""
-	   (bm-exec-diatheke term nil "plain" nil bm-hebrew-lexicon)
+	   (bm--exec-diatheke term nil "plain" nil bm-hebrew-lexicon)
 	   nil nil nil 7
 	   ))
-  (bm-display-term 'hebrew)
+  (bm--display-term 'hebrew)
   (setq bidi-paragraph-direction 'left-to-right))
 
 
-(defun bm-display-term-greek (term)
+(defun bm--display-term-greek (term)
   "Render the definition of the Strong's Greek TERM."
   (setq buffer-read-only nil)
   (erase-buffer)
-  (insert (replace-regexp-in-string
-	   (regexp-opt `(,bm-greek-lexicon))
-	   "" 
-	   (bm-exec-diatheke term nil "plain" nil bm-greek-lexicon)
-	   nil nil nil 7
-	   ))
-  ;;  (insert "\n")
-  (bm-display-term 'greek))
-
-
-(defun bm-set-location (book chapter &optional verse)
+  (if bm-use-abbott
+      (insert (replace-regexp-in-string "\(AbbottSmith\)" "" (bm--lookup-lex-def-abbott term)))
+    (insert (replace-regexp-in-string
+	     (regexp-opt `(,bm-greek-lexicon))
+	     ""
+	     (bm--exec-diatheke term nil "plain" nil bm-greek-lexicon)
+	     nil nil nil 7
+	     )))
+  (bm--display-term 'greek))
+
+
+(defun bm--set-location (book chapter &optional verse)
   "Sets the global chapter of the active `bible-mode' buffer."
   (setq-local bm-current-book book)
   (setq-local bm-current-book-name (car book))
   (setq-local bm-current-chapter chapter)
-  (bm-display verse))
+  (bm--display verse))
 
 ;;;;; Utilities
 
-(defun bm-list-number-range (min max &optional prefix)
+(defun bm--list-number-range (min max &optional prefix)
   "Returns a list containing entries for each integer between min and max.
 Used in tandem with `completing-read' for chapter selection."
   (let ((range-list nil))