More misc. cleanup

bible.el

@@ -54,12 +54,21 @@
 
 ;;; Code:
 
+;; Turn off tool bar mode because we are greedy for pixels....
+(tool-bar-mode -1)
+;; eldoc isn't meaningful in this program, and this saves space in the
+;; mode line.
+(global-eldoc-mode -1)
 
 ;;;; Requirements
+
+(require 'cl-lib) ; Just used for cl-search in two places.
 (require 'dom)
 (require 'shr)
+
   
-;;; Fix dom-text and dom-texts obsolescence (check for new function)
+;;; dom-text and dom-texts declared obsolescent in emacs 31. check for
+;;; new function, retain backward compatibility.
 (defalias 'bible-dom-text
   (if (fboundp 'dom-inner-text)
       (lambda (node)
@@ -76,11 +85,6 @@
       (lambda (node)
 	(dom-texts node)))))
 
-;; Turn off tool bar mode because we are greedy for pixels....
-(tool-bar-mode -1)
-;; eldoc isn't meaningful in this program, and this saves space in the
-;; mode line.
-(global-eldoc-mode -1)
 
 ;;;; Variables
 
@@ -91,7 +95,8 @@
 
 (defcustom bible-module
   "KJV"
-  "Book module for Diatheke to query."
+  "Default book module for Diatheke to query. (For full list of installed
+modules, run `diatheke -b system -l bibliography')"
   :type '(choice (const :tag "None" nil)
                  (string :tag "Module abbreviation (e.g. \"KJV\")"))
 ;;  :local t
@@ -101,14 +106,15 @@
 ;;; XXX Not implememted yet
 (defcustom bible-font
   "Ezra SIL"
-  "Default font for bible."
+  "Default font for bible (not yet implemented)."
   :type '(string :tag "Font family name (e.g. \"Ezra SIL\")")
   :local t
   :group 'bible)
 
 (defcustom bible-sword-query
-  "/usr/local/bin/diatheke"
-  "Program used to query sword modules---some version of diatheke."
+  "diatheke"
+  "Program used to query sword modules---some version of the sword
+library's diatheke program."
   :type '(string :tag "Sword library query executable (e.g. \"/usr/local/bin/diatheke\").")
   :local nil
   :group 'bible)
@@ -158,14 +164,15 @@ which are of the form
 ;;; correctly, so stick with the following.
 (defcustom bible-hebrew-lexicon
   "BDBGlosses_Strongs" ; This seems to work
-  "Lexicon used for displaying definitions of Hebrew words using Strong's codes."
-  :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
+  "Lexicon used for displaying definitions of Hebrew words using Strong's
+codes. Note that changing this may require changing some code. See
+bible--display-lemma-hebrew."
+  :type '(string :tag "Lexicon module (e.g. \"BDBGlosses_Strongs\")")
   :local nil
   :group 'bible)
 
 (defcustom bible-hebrew-lexicon-short
- "StrongsRealHebrew"
-  ;;  "NASHebrew"
+  "StrongsRealHebrew"
   "Lexicon used for displaying definitions of Hebrew words in tooltips."
   :type '(string :tag "Lexicon module (e.g. \"StrongsRealHebrew\")")
   :local nil
@@ -174,7 +181,8 @@ which are of the form
 
 (defcustom bible-word-study-enabled
   nil
-  "Display Strong's Hebrew, Strong's Greek, and Lemma words for study."
+  "Display original language Lemma words if present in module 
+(e.g. in KJV New Testament)."
   :type 'boolean
   :local t
   :group 'bible)
@@ -188,7 +196,7 @@ which are of the form
 
 (defcustom bible-show-diatheke-exec
   t
-  "Show the arguments by which diatheke is executed."
+  "Show the arguments by which diatheke is executed (mostly for debugging)."
   :type 'boolean
   :local nil
   :group 'bible)
@@ -231,6 +239,7 @@ which are of the form
   "A-list of name / chapter count for Bible books.")
 
 
+;; XXX Add abbreviations found in other documents/commentaries?
 (defvar bible--book-name-abbreviations
   '(;; Old Testament
     ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
@@ -274,7 +283,6 @@ which are of the form
     ("3 John"  . "III John")  ("III Jo" . "III John") ("3 Jo" . "III John") ("IIIJohn" . "III John")
     ("Ju"    . "Jude")
     ("Re"   . "Revelation of John") ("Rev"   . "Revelation of John"))
-
   "A-list of abbreviations for Bible books.")
 
 ;;;; Book / chapter
@@ -319,7 +327,8 @@ which are of the form
 (defun bible-toggle-display-diatheke ()
   "Toggle diatheke args display."
   (interactive)
-  (setq bible-show-diatheke-exec (not bible-show-diatheke-exec)))
+  (setq bible-show-diatheke-exec (not bible-show-diatheke-exec))
+  (message ""))
 
 (define-key bible-map
 	    [menu-bar bible display-diatheke]
@@ -446,12 +455,18 @@ which are of the form
 (setq tooltip-short-delay .5)
 (setq use-system-tooltips nil)
 
+;;(setq tooltip-mode -1)
+;;(setq tooltip-resize-echo-area t)
+
+
 (defun bible-toggle-tooltips ()
   "Toggle use of tooltips to display lexical/morphological items."
   (interactive)
   (setq bible-use-tooltips (not bible-use-tooltips))
   (tooltip-mode 'toggle)
-  (setq tooltip-resize-echo-area bible-use-tooltips))
+  (setq tooltip-resize-echo-area (not bible-use-tooltips))
+  (setq bible-show-diatheke-exec (and bible-show-diatheke-exec bible-use-tooltips)) ; Don't conflict with echo area
+  (message ""))
 
 
 (define-key bible-map
@@ -756,7 +771,7 @@ Handle abbreviations from lexicon module (AbbottSmith)."
 (defconst bible-diatheke-filter-options " avlnmw")
 
 ;;;; XXX
-;;;; Can we avoid returning (buffer-string) and just return the buffer?
+;;;; Can we avoid returning (buffer-string) and just use whatever buffer is current?
 ;;;;
 (defun bible--exec-diatheke (query &optional filter format module)
   "Execute `diatheke' with specified QUERY options, returning output
@@ -797,8 +812,9 @@ module."
 
 
 ;;; XXX Bible chapter titles mostly appear in Psalms. This code works
-;;; OK except for Psalm 119 which uses the chapter title as a heading
-;;; for each verse of the psalm.
+;;; OK except for Psalm 119 which changes the chapter title to
+;;; indicate the Hebrew letter that each verse of a stanza begins
+;;; with.
 ;;;
 ;;; Chapter titles seem to be part of each verse in the modules I saw.
 ;;;
@@ -810,9 +826,8 @@ module."
   "Text preceding start of chapter.
 Mostly in Psalms, like `Of David' or the like.")
 
-
 ;;;
-;;; Greek and Hebrew lexicon and morphemes tooltip rendering.
+;;; Greek and Hebrew lexeme and morpheme tooltip rendering.
 ;;;
 
 ;;; Hash tables for Lexical definitions.
@@ -837,8 +852,8 @@ Render HTML, return string.  Do some tweaking specific to morphology."
        '(("\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.
-    ))
+      (substring (buffer-string) (+ (length query) 1))))) ; This tries to get rid of unnecessary query identifier.
+
 
 ;;; Use "plain" format with diatheke.
 (defun bible--lex-query (query module)
@@ -851,7 +866,8 @@ 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))))
 
 ;;;
@@ -1018,32 +1034,6 @@ database and stash in cache."
 		 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. ."	.	"\nI.")
@@ -1091,9 +1081,11 @@ both tags, otherwise just get lex definition."
 	 (morph (get-text-property pos 'morph object))
 	 (morph-text (bible--lookup-morph-entry morph)))
     (when lex-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.
+      ;; This removes backslashes to prevent bogus command
+      ;; substitutions (that is, emacs mistakenly filling in a key
+      ;; binding for some command---see Info doc on Substituting Key
+      ;; Bindings) in the tooltip. XXX I couldn't figure out a better
+      ;; way to bypass command substitution in the tooltips.
       (subst-char-in-string 
        ?\\ 
        ?
@@ -1103,7 +1095,6 @@ both tags, otherwise just get lex definition."
 
 
 
-
 (defun bible-handle-divine-name (item)
   "When ITEM is divine name, display it as such."
   (insert "LORD")
@@ -1162,12 +1153,14 @@ in buffer)."
 
       ;; morphology
       (when morph
-	(let ((matched nil))
+	(let* ((matched nil)
+	       (morphemes (split-string morph))
+       (morpheme (car (last morphemes)))) ; KJV kludge as above
 	  (if (or
-	       (string-match "robinson:.*" morph)	; Robinson Greek morphology
-	       (string-match "packard:.*" morph)	; Packard Greek morphology --- LXX seems to use this
-	       (string-match "oshm:.*" morph))		; OSHM Hebrew morphology
-	      (setq matched (match-string 0 morph))
+	       (string-match "robinson:.*" morpheme)	; Robinson Greek morphology
+	       (string-match "packard:.*" morpheme)	; Packard Greek morphology --- LXX seems to use this
+	       (string-match "oshm:.*" morpheme))	; OSHM Hebrew morphology
+	      (setq matched (match-string 0 morpheme))
 	    ;;(message "Unknown morphology %s" morph)
 	    )
 	  (when matched
@@ -1216,7 +1209,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ;; Maybe process these at some point? Include footnotes etc.
 	       ;; ('node nil)
 	       ;; ('lb nil)
-	       ;; 'w --- Usual case.
+	       ;; 'w is 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))
@@ -1263,7 +1256,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ;; Various text properties---ignore for now
 	       ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties notitle))
 	       ;; Word inserted by translation, not in original, give visual indication.
-	       ((or 'transchange 'hi)
+	       ('transchange
 		(let ((word (bible-dom-text subnode)))
 		  (insert " " word)
 		  (if (plist-get iproperties 'jesus)
@@ -1308,7 +1301,7 @@ supplied, set cursor at verse."
 	(replace-match "" nil t)))
 
     (save-excursion
-      ;; Deal with chapter titles (i.e. in Psalms)
+       ;; Deal with chapter titles (i.e. in Psalms)
       ;; XXX 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".
@@ -1340,17 +1333,20 @@ supplied, set cursor at verse."
 				("‘ " . "‘")
 				(" ’" . "’")
 				(". ”" . ".”")
- 				("? ”" . "?”")
-				("   " . " ")
-				("  " . " "))
-			      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-lexemes " Lex")
-			  (when bible-has-morphemes " Morph")
-			  ")"))
+ 				("? ”" . "?”"))
+			      nil (point-min) (point-max)))
+
+    ;; Get rid of multiple consecutive spaces.
+    (save-excursion
+      (while (re-search-forward "  *" nil t) ; More than one space in a row
+	(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-lexemes " Lex")
+			    (when bible-has-morphemes " Morph")
+			    ")")))
 
   ;; If optional verse specification go to that verse.
   (when verse
@@ -1431,41 +1427,42 @@ supplied, set cursor at verse."
 	(query-verses "")
 	(buffer-read-only nil))
     (erase-buffer)
-    (save-excursion
-      (while match
-	(setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
-	      matchstr (match-string 0 results))
-
-	(when match
-	  (push
-	   ;; Massage match to make it more sortable, get rid of some characters.
-	   (replace-regexp-in-string
-	    ".+; " "" 
+    (while match
+      (setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
+	    matchstr (match-string 0 results))
+
+      (when match
+	(push
+	 ;; Massage match to make it more sortable, get rid of some characters.
+	 (replace-regexp-in-string
+	  ".+; " "" 
+	  (string-replace
+	   "I " "1"
+	   (string-replace
+	    "II " "2"
 	    (string-replace
-	     "I " "1"
-	     (string-replace
-	      "II " "2"
-	      (string-replace
-	       "III " "3"
-	       matchstr))))
-	   verses)))
-
-      (setq verses (sort verses :key nil :lessp #'(lambda (s1 s2) (string-version-lessp s1 s2))))
-      (dolist (verse verses)
-	(if query-verses
-	    (setq query-verses (concat query-verses ";" verse))
-	  (setq query-verses verse)))
-      (let ((bible-show-diatheke-exec nil))
-	(insert (bible--exec-diatheke query-verses nil nil bible-module))
-	(let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
-	  (erase-buffer)
-	  (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
-	  (while (re-search-forward (concat "^.*" bible-module ".*$") nil t)
-	    (replace-match "")))
-	(setq mode-name (concat "Bible Search (" bible-module))
-	(when bible-search-range
-	  (setq mode-name (concat mode-name " [" bible-search-range "]")))
-	(setq mode-name (concat mode-name ")"))))))
+	     "III " "3"
+	     matchstr))))
+	 verses)))
+
+    (sort verses #'string-version-lessp)
+    (dolist (verse verses)
+      (if query-verses
+	  (setq query-verses (concat query-verses ";" verse))
+	(setq query-verses verse)))
+    (let ((bible-show-diatheke-exec nil))
+	(insert (bible--exec-diatheke query-verses nil nil bible-module)))
+    (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
+      (erase-buffer)
+      (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil))
+    (goto-char (point-min))
+    (save-excursion
+      (while (re-search-forward (concat "^.*" bible-module) nil t)
+	(replace-match ""))))
+  (setq mode-name (concat "Bible Search (" bible-module))
+  (when bible-search-range
+    (setq mode-name (concat mode-name " [" bible-search-range "]")))
+  (setq mode-name (concat mode-name ")")))
 
 ;;;;; Terms (lemmas, morphemes)
 
@@ -1478,9 +1475,8 @@ supplied, set cursor at verse."
   "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.
     (save-excursion
+      ;; This enables clicking on Strong's numbers in some lexicon definitions.
       (while (search-forward-regexp "[0-9]+" nil t)
 	(let ((match (match-string 0))
 	      (start (match-beginning 0))
@@ -1500,7 +1496,6 @@ supplied, set cursor at verse."
 	(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)))
@@ -1528,6 +1523,7 @@ This code is customized for the BDBGlosses_Strongs lexicon."
     (erase-buffer)
     ;; BDBGlosses_Strongs needs the prefixed `H'.
     (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew (concat "H" lemma))) 7))
+;;    (insert (substring (bible--cleanup-lex-text (bible--lookup-lemma-hebrew lemma)) 7))
     (bible--fixup-lexicon-display 'hebrew)))