Refactor xref lookup

bible.el

@@ -210,7 +210,7 @@ which are of the form
   "A-list of name / chapter count for Bible books.")
 
 
-(defvar bible--book-name-abbreviations-alist
+(defvar bible--book-name-abbreviations
   '(;; Old Testament
     ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
     ("De"     . "Deuteronomy")     ("Js"    . "Joshua")           ("Jg"   . "Judges")	     ("Judg"   . "Judges")
@@ -549,6 +549,7 @@ Genesis 1:1 is used."
   (interactive)
   (with-current-buffer (get-buffer-create (generate-new-buffer-name (concat "*bible*")))
     (bible)
+    (eldoc-mode -1) ;; Why is this necessary to avoid eldoc minor mode?
     (bible--set-location
      (or (assoc (or book-name "Genesis") bible--books) (list book-name))
      (or chapter 1)
@@ -670,14 +671,14 @@ Create a new `bible' buffer positioned at the selected verse."
     (message "Following verse result: %s" text)
     (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
     (setq book (match-string 0 text))
-    (message "Book: %s" book)
-    (message "Following %s" text)
+;;    (message "Book: %s" book)
+;;    (message "Following %s" text)
     (string-match "[0-9]?[0-9]?:" text)
     (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
-    (message "Chapter: %s" chapter)
+;;    (message "Chapter: %s" chapter)
     (string-match ":[0-9]?[0-9]?[0-9]?" text)
     (setq verse (substring (match-string 0 text) 1))
-    (message "Verse: %s" verse)
+;;    (message "Verse: %s" verse)
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
 
 (defun bible-search-mode-follow-xref ()
@@ -690,22 +691,20 @@ Handle abbreviations from lexicon module (AbbottSmith)."
   (let* ((xref (get-text-property (point) 'xref))
 	 (verse-ref (split-string xref))
 	 book-abbrev
-	 book
 	 chapter-verse
+	 book
 	 chapter
 	 verse)
-
-    (if (= (length verse-ref) 3) ; II Cor 3:17 or the like
-	(setq book-abbrev (concat (car verse-ref) (cadr verse-ref))
-	      chapter-verse (split-string (caddr verse-ref) ":"))
-      ;; Mat 5 or the like
-      (setq book-abbrev (car verse-ref)
-	    chapter-verse (split-string (cadr verse-ref) ":")))
-
-    (setq book (cdr (assoc book-abbrev bible--book-name-abbreviations-alist)))
-    (unless book (setq book (car verse-ref))) ; Didn't find abbreviation
-    (setq chapter (car chapter-verse)
-	  verse   (cadr chapter-verse))
+    (cond ((= (length verse-ref) 2) ; Mat 5 or the like
+	   (setq book-abbrev (car verse-ref)
+		 chapter-verse (split-string (cadr verse-ref) ":")))
+	  ((= (length verse-ref) 3) ; II Cor 3:17 or the like
+	   (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
+		 chapter-verse (split-string (caddr verse-ref) ":"))))
+    (message "Book abbrev: %s" book-abbrev)
+    (setq book (or (alist-get book-abbrev bible--book-name-abbreviations nil nil #'string-equal-ignore-case) (car verse-ref))
+	  chapter (car chapter-verse)
+	  verse (cadr chapter-verse))
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
 
 
@@ -732,7 +731,7 @@ Handle abbreviations from lexicon module (AbbottSmith)."
          (verse (when chapter (read-from-minibuffer "Verse: ")))
 	 (query (concat (car book-data) " " chapter ":" verse))
 	 (args (list bible-sword-query nil (current-buffer) t "-b" bible-module "-f" "plain" "-k" query)))
-    (apply 'call-process args)))
+    (apply #'call-process args)))
 
 
 ;;;;; Support
@@ -1207,7 +1206,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)
-		  (put-text-property (- (point) (length word)) (point) 'face 'italic)))
+		  (add-face-text-property (- (point) (length word)) (point) '(:foreground "turquoise"))))
 	       ;; '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))
@@ -1215,18 +1214,31 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ;; These tags appear in ESV modules (and maybe others?) XXX still not right
 	       ('l
 		(let ((attributes (dom-attributes subnode)))
-		  (cond ((equal (cdr (assoc 'type attributes)) "x-br")
+		  (cond ((equal (dom-attr subnode 'type) "x-br")
 			 (bible-new-line))
-			((equal (cdr (assoc 'type attributes)) "x-indent")
+			((equal (dom-attr subnode 'type) "x-indent")
 			 (insert "\t"))
-			((assoc 'level attributes)
+			((dom-attr subnode 'level)
 			 (let ((indent (string-to-number (alist-get 'level attributes))))
-			   (when (= indent 2) (insert "\n\t")))))))
+			   (cond ((= indent 1) (insert "\t"))
+				 ((= indent 2) (insert "\n\t"))))))))
 	       ('divinename (bible-handle-divine-name subnode))
 	       ;; Some modules use this for line breaks and such.
 	       ('milestone (when (equal (dom-attr subnode 'type) "line") (bible-new-line)))
-;;	       ('br (bible-new-line))
+	       ('br (bible-new-line))
 	       ('div (when (equal (dom-attr subnode 'type) "paragraph") (bible-new-line)))
+	       ((or 'scripref 'reference) ;;; XXX Clicking on verse doesn't work yet.
+		(let ((word (dom-text subnode)))
+		  (let ((start (point)))
+		    (insert " " word)
+		    (let ((end (point)))
+		      (message word)
+		      (put-text-property start end 'xref word)
+		      (put-text-property start end 'keymap bible-search-mode-map)
+		      (put-text-property start end 'help-echo (concat "Go to " word " (doesn't work yet)"))
+		      (add-face-text-property start end '(:foreground "blue"))))))
+	       ('b (bible--insert-domnode-recursive subnode iproperties notitle))
+	       ('u (bible--insert-domnode-recursive subnode iproperties notitle))
 	       ;; Word inserted by translation, not in original, give visual indication.
 	       ((or 'transchange 'hi)
 		(let ((word (dom-text subnode)))
@@ -1447,30 +1459,37 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
   "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)
-      (cond ((eq termtype 'hebrew)
-	     (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:H" (match-string 0)))
-	     (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-hebrew-keymap)
-	     (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))
-	    ((eq termtype 'greek)
-	     (put-text-property (match-beginning 0) (match-end 0) 'strong (concat "strong:G" (match-string 0)))
-	     (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-greek-keymap)
-	     (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground "blue")))))
 
-    (goto-char (point-min))
+    ;; This enables clicking on Strong's numbers in some lexicon definitions.
+    (save-excursion
+      (while (search-forward-regexp "[0-9]+" nil t)
+	(let ((match (match-string 0))
+	      (start (match-beginning 0))
+	      (end (match-end 0)))
+	  (cond ((eq termtype 'hebrew)
+		 (put-text-property start end 'strong (concat "strong:H" match))
+		 (put-text-property start end 'keymap bible-hebrew-keymap)
+		 (add-face-text-property start end `(:foreground "blue")))
+		((eq termtype 'greek)
+		 (put-text-property start end 'strong (concat "strong:G" match))
+		 (put-text-property start end 'keymap bible-greek-keymap)
+		 (add-face-text-property start end `(:foreground "blue")))))))
 
     ;; This enables clicking on verse references.
-    (while (search-forward-regexp bible--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)
-      (put-text-property (match-beginning 0) (match-end 0) 'help-echo (concat "Go to " (match-string 0)))
-      (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue")))
-    (goto-char (point-min))
+    (save-excursion
+      (while (search-forward-regexp bible--verse-regexp nil t)
+	(let ((match (match-string 0))
+	      (start (match-beginning 0))
+	      (end (match-end 0)))
+	  ;; Strip spaces from match for 'xref property
+	  (put-text-property start end 'xref match)
+	  (put-text-property start end 'keymap bible-search-mode-map)
+	  (put-text-property start end 'help-echo (concat "Go to " (substring-no-properties match)))
+	  (add-face-text-property start end '(:foreground "blue")))))
 
-    (while (search-forward "()" nil t)
-      (replace-match ""))
-    (goto-char (point-min))))
+    (save-excursion
+      (while (search-forward "()" nil t)
+	(replace-match "")))))
 
 
 (defun bible--open-term-hebrew (term)