Fixes for tooltip display

bible.el

@@ -20,46 +20,6 @@
 ;; Biblical texts provided by the Sword project.
 ;; Word study is also supported.
 
-;;; 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.
@@ -73,7 +33,7 @@
 
 ;;; Design:
 
-;; The idea here is to use the diatheke program to insert code from
+;; The idea here is to use the diatheke program to insert text from
 ;; modules into buffers. The main bible display uses an "internal" XML
 ;; format. The whole buffer gets parsed by libxml-parse-html-region to
 ;; create a dom tree. This gets parsed by
@@ -176,7 +136,8 @@ which are of the form
   :group 'bible)
 
 (defcustom bible-hebrew-lexicon-short
-  "StrongsRealHebrew"
+ "StrongsRealHebrew"
+  ;;  "NASHebrew"
   "Lexicon used for displaying definitions of Hebrew words in tooltips."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
@@ -861,7 +822,7 @@ Plain format, returns string."
   "Return the Greek lemma from lemma index with a strong's number as KEY."
   (string-trim
    (string-replace
-    (concat "(" bible-lexicon-index ")") ""
+    (concat "(" bible-lexicon-index) ""
     (bible--lex-query key bible-lexicon-index))))
 
 ;;;
@@ -915,7 +876,7 @@ Massage output so verse cross references are usable.  Returns string."
       (when bible-show-diatheke-exec
 	(message "%s" args))
       (apply 'call-process args)
-      (bible--cleanup-lex-text (string-replace (concat "(" bible-greek-lexicon ")") "" (buffer-string))))))
+      (bible--cleanup-lex-text (string-replace (concat "(" bible-greek-lexicon ) "" (buffer-string))))))
 
 (defun bible--lookup-lemma-greek-indexed (key)
   "Lookup Greek lemma using Strong's number KEY.
@@ -949,8 +910,8 @@ Massage output so various cross references are usable. Returns string."
 	(message "%s" args))
       (apply 'call-process args)
       (bible--process-href)
-      (string-replace (concat "(" bible-hebrew-lexicon ")") "" (substring (buffer-string) 7)))))
-
+      (bidi-string-mark-left-to-right
+       (string-replace (concat "(" bible-hebrew-lexicon ) "" (substring (buffer-string) 7))))))
 
 (defun bible--lookup-lemma-hebrew (key)
   "Lookup lexical definition using Strong's number KEY.
@@ -973,10 +934,10 @@ Massage output so various cross references are usable. Returns string."
 
 (defun bible--lookup-lemma-hebrew-short (lemma)
   "Look up Hebrew lexical entry for LEX from short Hebrew 
-lexicon (StrongsRealGreek)."
+lexicon (StrongsRealHebrew)."
   (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)))
+    (substring (bible--lex-query (concat (match-string 0 lemma)) bible-hebrew-lexicon-short) 7)))
 
 (defun bible--lookup-lex (lex)
   "Look up lexical item LEX. This is used for tooltips.
@@ -994,16 +955,16 @@ database and stash in cache."
       	(setq lex-text
 	      (cond ((string-prefix-p "G" key)
 		     (string-replace 
-		      (concat "(" bible-greek-lexicon-short ")") 
+		      (concat "(" bible-greek-lexicon-short ) 
 		      ""
-		      ;; The Greek lexicon entries don't have line breaks, so limit lines to 75 chars.
-		      (string-fill (bible--lookup-lemma-greek-short key) 75)))
+		      (bible--lookup-lemma-greek-short key)))
 		    ((string-prefix-p "H" key)
-		     (string-replace
-		      (concat "(" bible-hebrew-lexicon-short ")")
-		      ""
-		      (string-fill (bible--lookup-lemma-hebrew-short key) 75)))))
-	(puthash key (bible--cleanup-lex-text lex-text) lex-hash)))))
+		     (bidi-string-mark-left-to-right
+		      (string-replace
+		       (concat "(" bible-hebrew-lexicon-short)
+		       ""
+		       (bible--lookup-lemma-hebrew-short key))))))
+	(puthash key (string-fill (bible--cleanup-lex-text lex-text) 75) lex-hash)))))
 
 (defun bible--lookup-morph-entry (morph)
   "Look up entry for morphological item MORPH. 
@@ -1022,7 +983,7 @@ database and stash in cache."
 			 ((string-prefix-p "oshm:" morph)
 			  (setq morph-module "OSHM")
 			  (setq morph-key (substring morph (length "oshm:")))))
-		   (string-replace (concat "(" morph-module ")")
+		   (string-replace (concat "(" morph-module )
 				   ""
 				   (bible--morph-query morph-key morph-module)))
 		 morph-hash))))
@@ -1236,6 +1197,12 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ;; ('lb nil)
 	       ;; 'w --- Usual case.
 	       ('w (insert " ") (bible--process-word subnode iproperties))
+	       ;; Font tag should be ignored, treat as if 'w
+	       ('font (insert " ") (bible--process-word subnode iproperties))
+	       ('i ; Italic face
+		(let ((word (dom-text subnode)))
+		  (insert " " word)
+		  (add-face-text-property (- (point) (length word)) (point) '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))
@@ -1253,6 +1220,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ('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))
 	       ('div (when (equal (dom-attr subnode 'type) "paragraph") (bible-new-line)))
 	       ;; Word inserted by translation, not in original, give visual indication.
 	       ((or 'transchange 'hi)
@@ -1286,53 +1254,54 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
 	(goto-char (point-min))))
 
-      ;; Remove the module name from the buffer.
-      (while (search-forward (concat "(" bible-module ")") nil t)
-	(replace-match ""))
-
-      ;; 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-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)))
+    ;; 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))
+
+    ;; 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-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.
@@ -1495,17 +1464,15 @@ 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)
+    (setq-local bidi-paragraph-direction 'left-to-right)
     (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-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. This code is customized for the BDBGlosses_Strongs
-lexicon."
+This code is customized for the BDBGlosses_Strongs lexicon."
   (let ((buffer-read-only nil))
     (erase-buffer)
     ;; BDBGlosses_Strongs needs the prefixed `H'.