Cleanup tooltip appearance (still not perfect)

bible.el

@@ -62,8 +62,6 @@
 
 
 ;;;; Requirements
-;;; XXX FMG there are just a few constructs that use this; use elisp versions instead.
-;;(require 'cl-lib)
 (require 'dom)
 (require 'shr)
 
@@ -169,11 +167,8 @@ which are of the form
 
 ;;; variable defs
 
-;;(defvar bible-mode-verse-regexp "([\d ]*[a-zA-Z]+( \d*:\d*)?)(( - )| )?(((\d* )?[a-zA-Z]+ )?\d*([:-]+\d*)?)")
-;; (defvar bible-mode-verse-regexp "/(\d*)\s*([a-z]+)\s*(\d+)(?::(\d+))?(\s*-\s*(\d+)(?:\s*([a-z]+)\s*(\d+))?(?::(\d+))?)?/i")
 (defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
 
-
 (defvar bible--modules (lazy-completion-table bible--modules bible--list-biblical-modules))
 
 ;; XXX I believe these chapter counts aren't the same for all modules, e.g. JPS.
@@ -885,8 +880,6 @@ as HTML links, depending on the lexicon module."
 
   (with-temp-buffer
     (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" key)))
-      ;; XXX Change to OSIS? Need to parse OSIS-style references.
-;;;    (let ((args (list "diatheke" nil (current-buffer) t "-b" bible-greek-lexicon "-o" "m" "-f" "OSIS" "-k" key)))
       (when bible-show-diatheke-exec
 	(message "%s" args))
       (apply 'call-process args)
@@ -940,20 +933,21 @@ stash in hash table, and return string."
 ;;; the lex and morph strings, hoping to speed up tooltip rendering.
 ;;;
 (defun bible--lookup-strongs-greek-short (lex)
-  "Look up shorter Greek lexical entry of LEX.
-If not found in hash table, get it from sword database, stash in hash table,
-and return string."
+  "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)))
 
 (defun bible--lookup-strongs-hebrew-short (lex)
-  "Look up Hebrew lexical text for LEX from short Hebrew lexicon."
+  "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-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))
+    (let* ((key (seq-subseq lex 7)) ; strip off "strong:" prefix.
 	   (lex-text (gethash key lex-hash)))
       (if lex-text
 	  lex-text
@@ -961,60 +955,89 @@ and return string."
 	      (cond ((string-prefix-p "G" key)
 		     (string-replace 
 		      (concat "(" bible-greek-lexicon-short ")") 
-		      "" 
-		      (bible--lookup-strongs-greek-short key)))
+		      ""
+		      ;; The Greek text doesn't have line breaks, so limit lines to 75 chars.
+		      (string-fill (bible--lookup-strongs-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)
-	))))
+	(puthash key (bible--cleanup-tooltip-text lex-text) lex-hash)))))
 
 (defun bible--lookup-morph (morph)
+  "Look up morphological item MORPH. 
+Return hash table entry if present in morph-hash cache, else look up in
+database and stash in cache."
   (when morph
     (or (gethash morph morph-hash)
 	(puthash morph
 		 (let (morph-module morph-key)
 		   (cond ((string-prefix-p "robinson:" morph)
 			  (setq morph-module "Robinson")
-			  (setq morph-key (replace-regexp-in-string "robinson:" "" morph)))
+			  (setq morph-key (seq-subseq morph (length "robinson:"))))
 			 ((string-prefix-p "packard:" morph)
 			  (setq morph-module "Packard")
-			  (setq morph-key (replace-regexp-in-string "robinson:" "" morph)))
+			  (setq morph-key (seq-subseq morph (length "packard:"))))
 			 ((string-prefix-p "oshm:" morph)
 			  (setq morph-module "OSHM")
-			  (setq morph-key (replace-regexp-in-string "oshm:" "" morph))))
+			  (setq morph-key (seq-subseq morph (length "oshm:")))))
 		   (string-replace (concat "(" morph-module ")")
 				   ""
 				   (bible--morph-query morph-key morph-module)))
 		 morph-hash))))
 
 
+;; (defvar bible-outline-strings
+;;   '((". ."	.	".")
+;;     (" I. ."	.	"\n I.")
+;;     (" II. ."	.	"\n II.")
+;;     (" III. ."	.	"\n III.")
+;;     (" IV. ."	.	"\n IV.")
+;;     (" V. ."	.	"\n V.")
+;;     ("1. ."	.	"\n  1.")
+;;     ("2. ."	.	"\n  2.")
+;;     ("3. ."	.	"\n  3.")
+;;     ("4. ."	.	"\n  4.")
+;;     ("5. ."	.	"\n  5.")
+;;     ("6. ."	.	"\n  6.")
+;;     ("7. ."	.	"\n  7.")
+;;     ("8. ."	.	"\n  8.")
+;;     ("9. ."	.	"\n  9.")
+;;     ("a. ."	.	"\n    a.")
+;;     ("b. ."	.	"\n    b.")
+;;     ("c. ."	.	"\n    c.")
+;;     ("d. ."	.	"\n    d.")
+;;     ("e. ."	.	"\n    e.")
+;;     ("f. ."	.	"\n    f.")
+;;     ("g. ."	.	"\n    g.")
+;;     ("h. ."	.	"\n    h.")
+;;     (" . "	.	". ")))
+
 (defvar bible-outline-strings
   '(;;(". ."	.	".")
-    (" I. ."	.	"\n I.")
-    (" II. ."	.	"\n II.")
-    (" III. ."	.	"\n III.")
-    (" IV. ."	.	"\n IV.")
-    (" V. ."	.	"\n V.")
-    ("1. ."	.	"\n  1.")
-    ("2. ."	.	"\n  2.")
-    ("3. ."	.	"\n  3.")
-    ("4. ."	.	"\n  4.")
-    ("5. ."	.	"\n  5.")
-    ("6. ."	.	"\n  6.")
-    ("7. ."	.	"\n  7.")
-    ("8. ."	.	"\n  8.")
-    ("9. ."	.	"\n  9.")
-    ("a. ."	.	"\n    a.")
-    ("b. ."	.	"\n    b.")
-    ("c. ."	.	"\n    c.")
-    ("d. ."	.	"\n    d.")
-    ("e. ."	.	"\n    e.")
-    ("f. ."	.	"\n    f.")
-    ("g. ."	.	"\n    g.")
-    ("h. ."	.	"\n    h.")
+    (" I. ."	.	"\nI.")
+    (" II. ."	.	" II.")
+    (" III. ."	.	" III.")
+    (" IV. ."	.	" IV.")
+    (" V. ."	.	" V.")
+    ("1. ."	.	"\n1.")
+    ("2. ."	.	"2.")
+    ("3. ."	.	"3.")
+    ("4. ."	.	"4.")
+    ("5. ."	.	"5.")
+    ("6. ."	.	"6.")
+    ("7. ."	.	"7.")
+    ("8. ."	.	"8.")
+    ("9. ."	.	"9.")
+    ("a. ."	.	"    a.")
+    ("b. ."	.	"    b.")
+    ("c. ."	.	"    c.")
+    ("d. ."	.	"    d.")
+    ("e. ."	.	"    e.")
+    ("f. ."	.	"    f.")
+    ("g. ."	.	"    g.")
+    ("h. ."	.	"    h.")
     (" . "	.	". ")))
 
 (defun bible--cleanup-tooltip-text (lex-text)
@@ -1042,7 +1065,7 @@ both tags, otherwise just get lex definition."
       (setq lex-morph-text (string-trim lex-text)))
     (when morph-text
       (setq lex-morph-text
-	    (concat lex-morph-text "\n\n" (string-trim 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.
@@ -1185,8 +1208,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ('seg (bible--insert-domnode-recursive subnode iproperties notitle))
 	       ('divinename (bible-handle-divine-name subnode))
 	       ;; This tag is used for red letter.
-	       ('q (bible--insert-domnode-recursive subnode iproperties notitle))
-	       ('p (bible--insert-domnode-recursive subnode iproperties notitle))
+	       ((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)))