Fix term mode lines, get lemma into mode line.

bible.el

@@ -23,7 +23,7 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this file; see the file LICENSE. If not, see
 ;; <https://www.gnu.org/licenses/>.
-
+
 ;;; Commentary:
 
 ;; Forked and extensively modified from package by Zacalot
@@ -64,13 +64,14 @@
 ;; up a tooltip with information about the word. Clicking on a word
 ;; with lexical information will display that information in a "term"
 ;; buffer.
-
+
 ;;; Code:
 
 ;;;; Environment stuff
 
-;; Turn off tool bar mode because we are greedy for pixels....
+;; Turn off modes because we are greedy for pixels....
 (tool-bar-mode -1)
+(scroll-bar-mode -1)
 
 ;; eldoc isn't meaningful in this program, and this saves space in the
 ;; mode line.
@@ -81,14 +82,14 @@
 (require 'cl-lib)
 (require 'dom)
 (require 'shr)
-
+
 ;;;; Aliases for obsolete functions
 
 ;; 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) 'dom-inner-text 'dom-text))
 (defalias 'bible-dom-texts (if (fboundp 'dom-inner-text) 'dom-inner-text 'dom-texts))
-
+
 ;;;; Customization Variables
 
 (defgroup bible nil
@@ -206,7 +207,7 @@ See `bible--display-lemma-hebrew'."
   :type 'boolean
   :local nil
   :group 'bible)
-
+
 ;;;; Mode line formats for different kinds of buffers.
 
 (defvar bible-mode-line-format
@@ -235,13 +236,12 @@ See `bible--display-lemma-hebrew'."
 (defvar bible-term-mode-line-format
   '("%e" mode-line-front-space
     mode-line-frame-identification mode-line-buffer-identification "   "
-    bible-search-text-this-query " " bible-search-word-this-query " "
-    (:eval (when bible-search-range-this-query (concat "<" bible-search-range-this-query "> ")))
-    (:eval (number-to-string bible-search-matches)) " matches"
+;;    bible-term-language 
+;;    " " (:eval bible-term-lemma)
     "  " mode-line-modes mode-line-misc-info
     mode-line-end-spaces)
   "Mode line format for bible search buffers.")
-
+
 ;;;; Modes
 
 (define-derived-mode bible special-mode "Bible"
@@ -271,23 +271,25 @@ See `bible--display-lemma-hebrew'."
   (buffer-disable-undo)
   (font-lock-mode t)
   (use-local-map bible-term-mode-map)
+  (setq-local mode-line-format bible-term-mode-line-format)
   (setq buffer-read-only t)
   (visual-line-mode t))
 
-(define-derived-mode bible-term-hebrew-mode bible-term-mode "Bible Term (Hebrew)"
+(define-derived-mode bible-term-hebrew-mode bible-term-mode "Bible Term"
   "Mode for researching Hebrew terms in the Bible.
-\\{bible-term-hebrew-mode-map}")
+\\{bible-term-hebrew-mode-map}"
+  (setq-local bible-term-language "Hebrew"))
 
-(define-derived-mode bible-term-greek-mode bible-term-mode "Bible Term (Greek)"
+(define-derived-mode bible-term-greek-mode bible-term-mode "Bible Term"
   "Mode for researching Greek terms in the Bible.
-\\{bible-term-greek-mode-map}")
-
+\\{bible-term-greek-mode-map}"
+  (setq-local bible-term-language "Greek"))
 
 (define-derived-mode bible-text-select-mode special-mode "Select Module"
   (buffer-disable-undo)
   (font-lock-mode t)
   (setq buffer-read-only t))
-
+
 
 ;;;; Keymaps
 
@@ -307,14 +309,19 @@ See `bible--display-lemma-hebrew'."
             [menu-bar bible display-diatheke]
             '("Toggle diatheke display" . bible-toggle-display-diatheke))
 
-(defvar-local bible-debugme nil
-  "Make text show up as XML when set.")
-
 (define-key bible-map "d" 'bible-toggle-display-xml)
 (define-key bible-map
             [menu-bar bible display-xml]
             '("Toggle XML Display" . bible-toggle-display-xml))
 
+(define-key bible-map
+            [menu-bar bible toggle-text-direction]
+            '("Toggle text direction (for Hebrew display)" . bible-toggle-text-direction))
+
+(define-key bible-map
+            [menu-bar bible toggle-tooltip-display]
+            '("Toggle Tooltip Display" . bible-toggle-tooltips))
+
 (define-key bible-map
             [menu-bar bible sep]
             '(menu-item '"--"))
@@ -392,13 +399,6 @@ See `bible--display-lemma-hebrew'."
             [menu-bar bible sepp]
             '(menu-item '"--"))
 
-(define-key bible-map
-            [menu-bar bible toggle-text-direction]
-            '("Toggle text direction (for Hebrew display)" . bible-toggle-text-direction))
-
-(define-key bible-map
-            [menu-bar bible toggle-tooltip-display]
-            '("Toggle Tooltip Display" . bible-toggle-tooltips))
 
 (define-key bible-map
             [menu-bar bible sepp]
@@ -453,7 +453,7 @@ See `bible--display-lemma-hebrew'."
 (defconst bible-text-map (make-keymap))
 (define-key bible-text-map [mouse-1] 'bible-pick-module)
 (define-key bible-text-map (kbd "RET") 'bible-pick-module)
-
+
 
 ;;;; Variable definitions
 
@@ -614,6 +614,12 @@ to all of them.")
 
 ;;;;; Lexemes / morphemes
 
+(defvar-local bible-term-language nil
+  "Displaying terms of this language.")
+
+(defvar-local bible-term-lemma nil
+  "Lemma for term mode line.")
+
 (defvar-local bible-has-lexemes nil
   "Set if the module being displayed has lexical entries availabile.")
 
@@ -622,6 +628,9 @@ to all of them.")
 
 (defvar-local bible-text-direction 'left-to-right)
 
+(defvar-local bible-debugme nil
+  "Make text show up as XML when set.")
+
 (defvar bible-use-tooltips t)
 (setq tooltip-delay 1)
 (setq tooltip-short-delay .5)
@@ -680,7 +689,8 @@ Mostly in Psalms, like `Of David' or the like.")
 (defvar-local bible-search-text-this-query "")
 (defvar-local bible-search-range-this-query nil)
 (defvar-local bible-search-matches 0)
-
+
+;;;; Functions
 
 ;;;;; Keymap helpers
 
@@ -722,27 +732,7 @@ Mostly in Psalms, like `Of David' or the like.")
   (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 ""))
-
-;;;; Terms
-
-(defun bible--display-greek ()
-  "Display Greek term.
-This command is run by clicking on text, not directly by the user."
-  (interactive)
-  (let ((item (car (split-string (get-text-property (point) 'strong)))))
-    ;; Remove "strong:G" prefix
-    (bible-term-greek (replace-regexp-in-string "strong:G" "" item))))
-
-(defun bible--display-hebrew ()
-  "Display Hebrew term.
-This command is run by clicking on text, not directly by the user."
-  (interactive)
-  (let ((item (car (split-string (get-text-property (point) 'strong)))))
-    ;; Remove "strong:H" prefix and any alphabetic suffixes.
-    (bible-term-hebrew (replace-regexp-in-string "strong:H" "" item))))
-
-
-;;;; Functions
+
 
 ;;;;; Commands (interactive)
 
@@ -766,6 +756,23 @@ specifies the module to use."
 
 ;;;;;; Navigation
 
+(defun bible--do-set-location (book chapter &optional verse)
+  (setq-local bible--current-book book)
+  (setq-local bible--current-book-name (car book))
+  (setq-local bible--current-chapter chapter)
+  (bible--display verse))
+
+(defun bible--set-location (book chapter &optional verse)
+  "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
+  (let ((buffer (current-buffer)))
+    (bible--do-set-location book chapter verse)
+    (when (cl-find buffer bible--synced-buffers)
+      (save-excursion
+	(dolist (buf bible--synced-buffers)
+	  (unless (eq buf buffer)
+	    (with-current-buffer buf
+	      (bible--do-set-location book chapter verse))))))))
+
 (defun bible-next-chapter ()
   "Page to the next chapter for the active `bible' buffer and 
 for any synchronized buffers."
@@ -900,7 +907,6 @@ for any synchronized buffers."
   "Search for a QUERY: a word or phrase.
 Asks the user for type of search: either `lucene', `phrase', `regex'
 or `multiword'.  `lucene' is the default search.
-
 `lucene' mode requires an index to be built using the `mkfastmod' program."
   (interactive "sBible Search: ")
   (when (> (length query) 0)
@@ -947,7 +953,7 @@ Handle abbreviations."
 	  (chapter (car chapter-verse))
           (verse (cadr chapter-verse)))
       (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse) (default-value 'bible-text)))))
-
+
 
 ;;;;;; User visible actions.
 
@@ -975,10 +981,10 @@ Handle abbreviations."
          (query (concat (car book-data) " " chapter ":" verse))
          (args (list bible-sword-query nil (current-buffer) t "-b" bible-text "-f" "plain" "-k" query)))
     (apply #'call-process args)))
-
-
+
 ;;;;;; Support (internal)
 
+;;;;;;; Diatheke interface
 
 (defun bible--exec-diatheke (query &optional filter format module)
   "Execute `diatheke' with specified QUERY options.
@@ -1039,15 +1045,8 @@ Render HTML, return string.  Do some tweaking specific to morphology."
   "Execute `diatheke' for QUERY, using MODULE.
 Plain format, returns string."
   (bible--exec-diatheke query nil "plain" module))
-  
-
-(defun bible--lookup-lemma-index (key)
-  "Return the Greek lemma from lemma index with a strong's number as KEY."
-  (string-trim
-   (string-replace
-    (concat "(" bible-lexicon-index)
-    ""
-    (bible--lex-query key bible-lexicon-index))))
+
+;;;;;; Lexicon processing
 
 ;; The Greek lexical definitions are done using the HTMLHREF output
 ;; format so they come out looking nice and having clickable
@@ -1108,6 +1107,11 @@ Massage output so verse cross references are usable.  Returns string."
       (apply #'call-process args)
       (bible--cleanup-lex-text (bible--remove-module-name bible-greek-lexicon (buffer-string))))))
 
+(defun bible--lookup-lemma-index (key)
+  "Return the Greek lemma from lemma index with a strong's number as KEY."
+  (string-trim
+   (bible--remove-module-name bible-lexicon-index (bible--lex-query key bible-lexicon-index))))
+
 (defun bible--lookup-lemma-greek-indexed (key)
   "Lookup Greek lemma using Strong's number KEY.
 Then look up the definition of that lemma.  Used when two-stage
@@ -1178,11 +1182,6 @@ database and stash in cache."
   (when lex
     (let* ((key (substring lex 7)) ; strip off "strong:" prefix.
            (lex-text (gethash key lex-hash)))
-      ;; FIXME: Kludge alert! Emacs tooltips look really nice for
-      ;;        Greek terms, but Hebrew needs system tooltips because
-      ;;        of direction issues. Need to track down tooltip
-      ;;        problem. (FMG 5-Mar-2026)
-;;      (setq use-system-tooltips (if (string-prefix-p "G" key) nil t))
       (if lex-text
           lex-text
         (setq lex-text
@@ -1235,9 +1234,8 @@ both tags, otherwise just get lex definition."
        (if morph-text
            (concat (string-trim lex-text) "\n" (string-trim morph-text))
          (string-trim lex-text))))))
-
-
-;;;; Display Bible text
+
+;;;; Display module text
 
 (defun bible-handle-divine-name (item)
   "When ITEM is divine name, display it as such."
@@ -1329,11 +1327,6 @@ in buffer)."
               (add-face-text-property refstart (point) '(:foreground "blue"))
               (put-text-property refstart (point) 'keymap bible-lemma-keymap))))))))
 
-(defun bible-new-line ()
-  "Ensure beginning of line.  Try to avoid redundant blank lines."
-  (unless (bolp)
-    (newline)))
-
 (defun bible--insert-title (title-node)
   "Insert the text in TITLE-NODE into buffer as a chapter title. 
 Since each verse will have a `title' tag, keep track and only emit a
@@ -1413,7 +1406,6 @@ In processing subnodes, each case will prepend a space if it needs it."
                ;; TODO: There are lots of tags we don't handle, especially in commentaries.
 	       ;;       Maybe process these at some point? Include footnotes etc.
                ;;       (FMG 5-Mar-2026)
-               ;; ('node nil)
                ;; 'w is usual case.
                ('w (insert " ") (bible--process-word subnode iproperties))
 	       ('title 
@@ -1422,10 +1414,10 @@ In processing subnodes, each case will prepend a space if it needs it."
 		;; talking about YOU, Psalm 119.
 		(if bible-chapter-title 
 		    (bible--insert-title subnode) ; Middle of chapter.
-		  (save-excursion
+		  (save-excursion                 ; Beginning of chapter.
 		    (goto-char (point-min))
-		    (bible--insert-title subnode)))) ; Beginning of chapter.
-	       ;; Font tag should be ignored, treat as if 'w
+		    (bible--insert-title subnode))))
+	       ;; Font tag ignored for now, treat as if 'w.
                ('font (insert " ") (bible--process-word subnode iproperties))
                ('hi (when (equal (dom-attr subnode 'type) "bold")
 		      (just-one-space)
@@ -1433,7 +1425,8 @@ In processing subnodes, each case will prepend a space if it needs it."
 			    (start (point)))
                         (insert word)
                         (put-text-property start (point) 'face 'bold))))
-               ('i ; Italic face (special case for certain module)
+	       ;; Italic face (special case for certain module)
+               ('i
 		(just-one-space)
                 (let ((word (bible-dom-text subnode))
 		      (start (point)))
@@ -1445,13 +1438,13 @@ In processing subnodes, each case will prepend a space if it needs it."
 	       ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties))
                ('l (bible--level-tag subnode))
 	       ;; REVIEW: divine name handling doesn't seem to work the same
-	       ;;         with all modules.
+	       ;;         with all modules. (FMG 26-Mar-2026)
 	       ('divinename (bible-handle-divine-name subnode))
                ;; Some modules use this for line breaks and such.
                ('milestone
 		(pcase (dom-attr subnode 'type)
 		("line" (bible-new-line))
-;;		("x-PN" (bible-new-line))
+;;		("x-PN" (bible-new-line)) ; REVIEW: Don't yet understand this one. (FMG 26-Mar-2026)
 		("x-p" (insert (dom-attr subnode 'marker) " "))))
                ('br (bible-new-line))
                ('lb (when (equal (dom-attr subnode 'type) "x-begin-paragraph") (bible-new-line)))
@@ -1459,9 +1452,8 @@ In processing subnodes, each case will prepend a space if it needs it."
 			       (equal (dom-attr subnode 'type) "x-p"))
 		       (bible-new-line)))
                ;; For commentaries and the like.
-               ;; TODO: Clicking on verse doesn't work yet. This will take work. (FMG 5-Mar-2026)
                ((or 'scripref 'reference) (bible--insert-xref subnode))
-               ;; Various text properties---ignore for now
+               ;; Various text properties---ignore for now. REVIEW: (FMG 26-Mar-2026)
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ;; Word inserted by translation, not in original, give visual indication.
                ('transchange
@@ -1472,12 +1464,10 @@ In processing subnodes, each case will prepend a space if it needs it."
                   (insert word)
                   (add-face-text-property start (point) face)))))))))
 
-(defun bible--display (&optional _module verse)
+(defun bible--display (&optional verse)
   "Render a page (chapter) of a Bible module.
 Defaults to using `bible-text'.
-If optional argument MODULE is supplied, use that module for display.
 If optional argument VERSE is supplied, set cursor at verse."
-;;  (when module (setq-local bible-text module))
   (let ((buffer-read-only nil)
         (bible-has-lexemes nil)
         (bible-has-morphemes nil))
@@ -1535,7 +1525,6 @@ If optional argument VERSE is supplied, set cursor at verse."
     ;; Get rid of multiple consecutive spaces.
     (save-excursion
       (while (re-search-forward "  *" nil t) ; More than one space in a row
-;;        (replace-match " ")))
         (just-one-space)))
     ;; Set the mode line of the biffer.
     (if bible-has-lexemes
@@ -1544,7 +1533,6 @@ If optional argument VERSE is supplied, set cursor at verse."
     (if bible-has-morphemes
 	(unless (string-match " Morph" mode-name) (setq mode-name (concat mode-name " Morph")))
       (setq mode-name (replace-regexp-in-string " Morph" "" mode-name)))
-;;    (setq mode-name (concat mode-name (when bible-has-lexemes " Lex") (when bible-has-morphemes " Morph")))
     (force-mode-line-update))
     ;; If optional verse specification go to that verse.
     (when verse
@@ -1659,7 +1647,7 @@ If optional argument VERSE is supplied, set cursor at verse."
                   "No results found."
                   (when (equal searchmode "lucene")
                     " Verify index has been build with mkfastmod.")))
-      (with-current-buffer (get-buffer-create (concat "*bible-search*"))
+      (with-current-buffer (get-buffer-create (generate-new-buffer-name (concat "*bible-search*")))
         (bible-search-mode)
 	(bible--display-search results module)
 	(setq-local bible-search-word-this-query query
@@ -1715,6 +1703,40 @@ If optional argument VERSE is supplied, set cursor at verse."
 
 ;;;; Terms (lemmas, morphemes)
 
+(defun bible--get-lemma (language strongs)
+  "Get the lemma from lexicon for LANGUAGE for strong's term STRONGS.
+Used to display lemmas in mode lines."
+  (let ((lemma-entry
+	 (pcase language
+	   ('hebrew
+	    ;; Use Strong's Hebrew lexicon to look up Hebrew lemma.
+	    (bible--lex-query strongs "StrongsHebrew" ))
+	   ('greek
+	    ;; Use Strong's Greek lexicon to look up Greek lemma.
+	    (bible--lex-query strongs "StrongsGreek")))))
+    (unless (equal lemma-entry "")
+      ;; Entry will look like <num>: <num>. <lemma> <definition>. Get
+      ;; rid of everything before and after <lemma>.
+      (let* ((lemma-line (split-string lemma-entry))
+	     (lemma (caddr lemma-line)))
+	lemma))))
+
+(defun bible--display-greek ()
+  "Display Greek term.
+This command is run by clicking on text, not directly by the user."
+  (interactive)
+  (let ((item (car (split-string (get-text-property (point) 'strong)))))
+    ;; Remove "strong:G" prefix
+    (bible-term-greek (replace-regexp-in-string "strong:G" "" item))))
+
+(defun bible--display-hebrew ()
+  "Display Hebrew term.
+This command is run by clicking on text, not directly by the user."
+  (interactive)
+  (let ((item (car (split-string (get-text-property (point) 'strong)))))
+    ;; Remove "strong:H" prefix and any alphabetic suffixes.
+    (bible-term-hebrew (replace-regexp-in-string "strong:H" "" item))))
+
 ;;(defun bible-display-morphology (morph)
 ;; ;; REVIEW: Do something here? (FMG 5-Mar-2026)
 ;;  )
@@ -1723,22 +1745,7 @@ If optional argument VERSE is 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))
-    ;;; (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))
-    ;;;           (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.
-    ;; REVIEW: this should be conflated with bible--insert-xref above. (FMG 25-Mar-2026)
     (save-excursion
       (while (search-forward-regexp bible--verse-regexp nil t)
         (let ((match (match-string 0))
@@ -1754,9 +1761,10 @@ If optional argument VERSE is supplied, set cursor at verse."
 
 (defun bible--open-term-hebrew (term)
   "Open a buffer of the Strong's Hebrew TERM's definition."
-  (with-current-buffer (get-buffer-create (concat "*bible-term-hebrew-" term "*"))
+  (with-current-buffer (get-buffer-create (generate-new-buffer-name "*bible-term*"))
     (bible-term-hebrew-mode)
     (setq-local bidi-paragraph-direction 'left-to-right)
+    (setq-local mode-name (concat (bible--get-lemma 'hebrew term) " Term (Hebrew)"))
     (bible--display-lemma-hebrew term)
     (pop-to-buffer (current-buffer) nil t)
     (fit-window-to-buffer)))
@@ -1768,13 +1776,13 @@ 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)))
 
 (defun bible--open-term-greek (term)
   "Open a buffer of the Strong's Greek TERM definition."
-  (with-current-buffer (get-buffer-create (concat "*bible-term-greek-" term "*"))
+  (with-current-buffer (get-buffer-create (generate-new-buffer-name "*bible-term*"))
     (bible-term-greek-mode)
+    (setq-local mode-name (concat (bible--get-lemma 'greek term) " Term (Greek)"))
     (bible--display-lemma-greek term)
     (pop-to-buffer (current-buffer) nil t)
     (fit-window-to-buffer)))
@@ -1785,33 +1793,20 @@ This code is customized for the BDBGlosses_Strongs lexicon."
     (erase-buffer)
     (insert (bible--lookup-lemma-greek lemma))
     (bible--fixup-lexicon-display 'greek)))
-
-(defun bible--do-set-location (book chapter &optional verse)
-  (setq-local bible--current-book book)
-  (setq-local bible--current-book-name (car book))
-  (setq-local bible--current-chapter chapter)
-  (bible--display bible-text verse))
-
-(defun bible--set-location (book chapter &optional verse)
-  "Set the BOOK, CHAPTER and optionally VERSE of the active `bible' buffer."
-  (let ((buffer (current-buffer)))
-    (bible--do-set-location book chapter verse)
-    (when (cl-find buffer bible--synced-buffers)
-      (save-excursion
-	(dolist (buf bible--synced-buffers)
-	  (unless (eq buf buffer)
-	    (with-current-buffer buf
-	      (bible--do-set-location book chapter verse))))))))
-
+
 ;;;; Utilities
 
+(defun bible-new-line ()
+  "Ensure beginning of line.  Try to avoid redundant blank lines."
+  (unless (bolp)
+    (newline)))
+
 (defun bible--remove-module-name (module-name string)
   "Remove parenthesized MODULE-NAME from STRING.
 Also deals with bug where some versions of diatheke return string that
 is missing close parenthesis."
   (replace-regexp-in-string (concat "^(" module-name ".*$") "" string))
 
-
 (defun bible--list-number-range (min max &optional prefix)
   "Returns a list containing entries for each integer between MIN and MAX.
 If PREFIX is supplied, prepend PREFIX to the entries.