Fixed verse number highlighting, title rendering

bible.el

@@ -85,6 +85,13 @@
   :local t
   :group 'bible)
 
+(defcustom bible-sword-query
+  "/usr/local/bin/diatheke"
+  "Program used to query sword modules---some version of diatheke."
+  :type '(string :tag "Sword library query executable (e.g. \"/usr/local/bin/diatheke\").")
+  :local nil
+  :group 'bible)
+
 
 (defcustom bible-greek-lexicon
   ;; AbbottSmithStrongs now has both links to lemmas and definitions
@@ -268,8 +275,8 @@ which are of the form
 
 (defvar bible-search-range nil)
 
-(defvar-local bible-has-strongs nil
-  "Set if the module being displayed has strongs numbers availabile.")
+(defvar-local bible-has-lexemes nil
+  "Set if the module being displayed has lexical entries availabile.")
 
 (defvar-local bible-has-morphology nil
   "Set if the module being displayed has morphology availabile.")
@@ -718,7 +725,7 @@ Handle abbreviations from lexicon module (AbbottSmith)."
          (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: ")))
 	 (query (concat (car book-data) " " chapter ":" verse))
-	 (args (list "diatheke" nil (current-buffer) t "-b" bible-module "-f" "plain" "-k" query)))
+	 (args (list bible-sword-query nil (current-buffer) t "-b" bible-module "-f" "plain" "-k" query)))
     (apply 'call-process args)))
 
 
@@ -735,7 +742,7 @@ buffer. FILTER is the Diatheke filter argument. FORMAT is either plain
 or the default of internal. MODULE is the text module to use."
   (let ((module (or module bible-module)))
     (with-temp-buffer
-      (let ((args (list "diatheke" nil (current-buffer) t "-b" module)))
+      (let ((args (list bible-sword-query nil (current-buffer) t "-b" module)))
 	(if filter
 	    (setq filter (concat filter bible-diatheke-filter-options))
 	  (setq filter bible-diatheke-filter-options))
@@ -753,7 +760,7 @@ search type. Optional argument FORMAT is either plain or the default of
 internal. MODULE is the text module to use and defaults to the current
 module."
   (with-temp-buffer
-    (let ((args (list "diatheke" nil (current-buffer) t "-b" (or module bible-module))))
+    (let ((args (list bible-sword-query nil (current-buffer) t "-b" (or module bible-module))))
       (setq args (append args (list "-s" (pcase searchtype
 					   ("lucene" "lucene")
 					   ("phrase" "phrase")
@@ -799,7 +806,7 @@ Mostly in Psalms, like `Of David' or the like.")
   "Execute `diatheke' to do morph QUERY, using MODULE.
 Render HTML, return string.  Do some tweaking specific to morphology."
   (with-temp-buffer
-    (let ((args (list "diatheke" nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
+    (let ((args (list bible-sword-query nil (current-buffer) t "-b" module "-o" "m" "-f" "HTMLHREF" "-k" query)))
       (when bible-show-diatheke-exec
 	(message "%s" args))
       (apply 'call-process args)
@@ -872,7 +879,7 @@ them to the <bookname> <chapter>:<verse> format."
   "Execute `diatheke' to do query on KEY.
 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" "plain" "-k" key)))      
+    (let ((args (list bible-sword-query 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)
@@ -905,7 +912,7 @@ lexical definition is set for a particular lexicon."
   "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)))
+    (let ((args (list bible-sword-query nil (current-buffer) t "-b" bible-hebrew-lexicon "-f" "plain" "-k" key)))
       (when bible-show-diatheke-exec
 	(message "%s" args))
       (apply 'call-process args)
@@ -1118,18 +1125,22 @@ in buffer)."
 	(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.*" 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
-	    (setq bible-has-strongs t)
-	    (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
-	    (put-text-property refstart refend 'strong matched))))
+	       (lexeme (car (last lexemes))))
+;;	  (message "Lexemes: %s" lexemes)
+	  (when (string-match "strong:.*" lexeme)
+	    (dolist (word (split-string (match-string 0 lexeme) " "))
+;;	      (message "Word: %s" word)
+	      (cond ((string-match "strong:G.*" word) ; Greek
+		     (setq matched (match-string 0 lexeme))
+		     (put-text-property refstart refend 'keymap bible-greek-keymap))
+		    ((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
+	      (setq bible-has-lexemes t)
+	      (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
+	      (put-text-property refstart refend 'strong matched)))))
 
       ;; morphology
       (when morph
@@ -1177,14 +1188,6 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
   (dolist (subnode (dom-children node))
     (cond ((null subnode) nil)
 	  ((stringp subnode)
-	   (let ((search-string (concat (car bible--current-book) " " (number-to-string bible--current-chapter) ":"))
-		 (start 0))
-	     ;; Delete <Book Ch:> (may be more than one)
-	     (setq subnode (string-replace search-string "" subnode))
-	     ;; Highlight verse number(s)
-	     (while (string-match "^ ?[0-9]+:" subnode start)
-	       (setq start (match-end 0))
-	       (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple") nil subnode)))
 	   ;; Red letter
 	   (when (plist-get iproperties 'jesus)
 	     (add-face-text-property 0 (length subnode) '(:foreground "red") nil subnode))
@@ -1202,7 +1205,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ('i ; Italic face
 		(let ((word (dom-text subnode)))
 		  (insert " " word)
-		  (add-face-text-property (- (point) (length word)) (point) 'italic)))
+		  (put-text-property (- (point) (length word)) (point) 'face 'italic)))
 	       ;; '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))
@@ -1240,11 +1243,10 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
   ;; Clear buffer and insert the result of calling bible--exec-diatheke.
   (let ((buffer-read-only nil)
 	(bible-chapter-title nil)
-	(bible-has-strongs nil)
+	(bible-has-lexemes nil)
 	(bible-has-morphology nil))
     (erase-buffer)
     (insert (bible--exec-diatheke (concat bible--current-book-name ":" (number-to-string bible--current-chapter))))
-
     ;; Parse the xml in the buffer into a DOM tree.
     (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
       ;; Render the DOM tree into the buffer.
@@ -1253,56 +1255,65 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	;; Looking for the "body" tag in the DOM node.
 	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
 	(goto-char (point-min))))
+    (save-excursion
+      (let ((search-string (concat (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
+	;; Delete <Book Ch:> (may be more than one)
+	(while (search-forward search-string nil t)
+	  (replace-match ""))))
+    (save-excursion
+      ;; Highlight verse number(s)
+      (while (re-search-forward "^ *[0-9]+" nil t)
+	(add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple") nil)))
+
+    (save-excursion
+      ;; Remove the module name from the buffer.
+      (while (re-search-forward (concat "^.*" bible-module ".*$") nil t)
+	;;      (message "Replacing %s" (concat "(" bible-module ")"))
+	(replace-match "" nil t)))
 
-    ;; Remove the module name from the buffer.
-    (while (search-forward (concat "(" bible-module) nil t)
-;;      (message "Replacing %s" (concat "(" bible-module ")"))
-      (replace-match "" nil t))
+    ;; Deal with chapter titles (i.e. in Psalms)
+    ;; N.B. This won't change a title inside a chapter, and so it
+    ;; doesn't work with Psalm 119 where the acrostic letters get
+    ;; printed as "titles".
+    (save-excursion
+      (when bible-chapter-title ; This gets set in bible-insert-domnode-recursive.
+	(let ((title-text (dom-texts bible-chapter-title))
+	      (refstart (point-min))
+	      refend)
+	  (when (stringp title-text)
+	    (setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
+	    (insert title-text "\n")
+	    (setq refend (point))
+	    (put-text-property refstart refend 'face 'bold))))
+
+      ;; Get rid of spurious spaces.
+      (format-replace-strings '(("." . ". ")
+				("," . ", ")
+				(";" . "; ")
+				(":" . ": ")
+				("?" . "? ")
+				("!" . "! ")
+				(" ." . ". ")
+				(" ," . ", ")
+				(" ;" . "; ")
+				(" :" . ": ")
+				(" ?" . "? ")
+				(" !" . "! ")
+				("“ " . "“")
+				("‘ " . "‘")
+				(" ’" . "’")
+				(". ”" . ".”")
+ 				("? ”" . "?”")
+				("   " . " ")
+				("  " . " "))
+			      nil (point-min) (point-max)))
 
     ;; Set the mode line of the biffer.
     (setq mode-name (concat "Bible (" bible--current-book-name " " (number-to-string bible--current-chapter) ") "
 			    bible-module
-			    (when bible-has-strongs " Lex")
+			    (when bible-has-lexemes " Lex")
 			    (when bible-has-morphology " Morph")
-			    ")"))
-
-    ;; Deal with chapter titles (i.e. in Psalms)
-    ;; N.B. This won't change a title inside a chapter, and so it
-    ;; doesn't work with Psalm 119 where the acrostic letters get
-    ;; printed as "titles".
-    (when bible-chapter-title ; This gets set in bible-insert-domnode-recursive.
-      (goto-char (point-min))
-      (let ((title-text (dom-texts bible-chapter-title))
-	    (refstart (point-min))
-	    refend)
-	;; Insert and make bold the title.
-	(when (stringp title-text)
-	  (insert title-text "\n")
-	  (setq refend (point))
-	  (put-text-property refstart refend 'face 'bold))))
-
-    ;; Get rid of spurious spaces.
-    (format-replace-strings '(("." . ". ")
-			      ("," . ", ")
-			      (";" . "; ")
-			      (":" . ": ")
-			      ("?" . "? ")
-			      ("!" . "! ")
-			      (" ." . ". ")
-			      (" ," . ", ")
-			      (" ;" . "; ")
-			      (" :" . ": ")
-			      (" ?" . "? ")
-			      (" !" . "! ")
-			      ("“ " . "“")
-			      ("‘ " . "‘")
-			      (" ’" . "’")
-			      (". ”" . ".”")
- 			      ("? ”" . "?”")
-			      ("   " . " ")
-			      ("  " . " "))
-			    nil (point-min) (point-max)))
-  (goto-char (point-min))
+			    ")")))
 
   ;; If optional verse specification go to that verse.
   (when verse