Просмотр исходного кода

Fix setting Lex and Morph mode line indicators.

Fred Gilham 1 неделя назад
Родитель
Сommit
96e8e15fe2
1 измененных файлов с 52 добавлено и 61 удалено
  1. 52 61
      bible.el

+ 52 - 61
bible.el

@@ -234,7 +234,7 @@ See `bible--display-lemma-hebrew'."
     " "  (:eval (number-to-string bible--current-chapter))
     " "  (:eval (number-to-string bible--current-chapter))
     "  " (:eval (if bible--synced-p "Sync" ""))
     "  " (:eval (if bible--synced-p "Sync" ""))
     (:eval (when bible-search-range (concat " <" bible-search-range ">")))
     (:eval (when bible-search-range (concat " <" bible-search-range ">")))
-    "  " mode-line-modes mode-line-misc-info
+    "  " mode-line-modes bible-lex bible-morph mode-line-misc-info
     mode-line-end-spaces)
     mode-line-end-spaces)
   "Mode line format for bible buffers.")
   "Mode line format for bible buffers.")
 
 
@@ -664,6 +664,9 @@ to all of them.")
 
 
 ;;;;; Lexemes / morphemes
 ;;;;; Lexemes / morphemes
 
 
+(defvar-local bible-lex nil)
+(defvar-local bible-morph nil)
+
 (defvar-local bible-term-language nil
 (defvar-local bible-term-language nil
   "Displaying terms of this language.")
   "Displaying terms of this language.")
 
 
@@ -1338,40 +1341,40 @@ Return a string that is intended to be displayed in a tooltip."
   "Look up lexical item LEX. This is used for tooltips.
   "Look up lexical item LEX. This is used for tooltips.
 Return hash table entry if present in `lex-hash' cache, else look up in
 Return hash table entry if present in `lex-hash' cache, else look up in
 database and stash in cache."
 database and stash in cache."
-  (when lex
-    (let* ((key (substring lex 7))  ; strip off "strong:" prefix.
-           (entry (gethash key lex-hash)))
-      (unless entry 
-        (setq entry 
-              (cond ((string-prefix-p "G" key)
-                     (bible--lookup-lemma-short key bible-greek-lexicon-short))
-                    ((string-prefix-p "H" key)
-                     (concat (string ?\x200e)
-                             (bible--lookup-lemma-short key bible-hebrew-lexicon-short)))))
-        (puthash key (string-fill (bible--cleanup-lex-text entry) 75) lex-hash))
-      entry)))
-
-
-(defun bible--lookup-morph-entry (morph)
+  (let* ((key (substring lex 7))        ; strip off "strong:" prefix.
+         (entry (gethash key lex-hash)))
+    (unless entry 
+      (setq entry 
+            (cond ((string-prefix-p "G" key)
+                   (bible--lookup-lemma-short key bible-greek-lexicon-short))
+                  ((string-prefix-p "H" key)
+                    ;; Force left-to-right for tooltips.
+                   (concat (string ?\x200e)
+                           (bible--lookup-lemma-short key bible-hebrew-lexicon-short)))))
+      (puthash key (string-fill (bible--cleanup-lex-text entry) 75) lex-hash))
+    entry))
+
+
+(defun bible--lookup-morph (morph)
   "Look up entry for morphological item MORPH.
   "Look up entry for morphological item MORPH.
 Return hash table entry if present in `morph-hash' cache, else look up in
 Return hash table entry if present in `morph-hash' cache, else look up in
 database and stash in cache."
 database and stash in cache."
-  (when morph
-    (or (gethash morph morph-hash)
-        (puthash morph
-                 (let (morph-module morph-key)
-                   ;; We know about these modules. (Assume they're installed.)
-                   (cond ((string-prefix-p "robinson:" morph)
-                          (setq morph-module "Robinson")
-                          (setq morph-key (substring morph (length "robinson:"))))
-                         ((string-prefix-p "packard:" morph)
-                          (setq morph-module "Packard")
-                          (setq morph-key (substring morph (length "packard:"))))
-                         ((string-prefix-p "oshm:" morph)
-                          (setq morph-module "OSHM")
-                          (setq morph-key (substring morph (length "oshm:")))))
-                   (bible--remove-module-name morph-module (bible--morph-query morph-key morph-module)))
-                 morph-hash))))
+  (or (gethash morph morph-hash)
+      (puthash morph
+               (let (morph-module morph-key)
+                  ;; We know about these modules. (Assume they're installed.)
+                  (cond ((string-prefix-p "robinson:" morph)
+                         (setq morph-module "Robinson")
+                         (setq morph-key (substring morph (length "robinson:"))))
+                        ((string-prefix-p "packard:" morph)
+                         (setq morph-module "Packard")
+                         (setq morph-key (substring morph (length "packard:"))))
+                        ((string-prefix-p "oshm:" morph)
+                         (setq morph-module "OSHM")
+                         (setq morph-key (substring morph (length "oshm:")))))
+                  (bible--remove-module-name morph-module (bible--morph-query morph-key morph-module)))
+               morph-hash)))
+      
 
 
 ;; Get string for tooltip display
 ;; Get string for tooltip display
 (defun bible--show-lex-morph (_window object pos)
 (defun bible--show-lex-morph (_window object pos)
@@ -1379,22 +1382,17 @@ database and stash in cache."
 Include both lex and morph definitions if text module has both tags,
 Include both lex and morph definitions if text module has both tags,
 otherwise just get lex definition."
 otherwise just get lex definition."
   (let* ((lex (get-text-property pos 'strong object))
   (let* ((lex (get-text-property pos 'strong object))
-         (lex-text (bible--lookup-lex lex))
+         (lex-text (and lex (bible--lookup-lex lex)))
          (morph (get-text-property pos 'morph object))
          (morph (get-text-property pos 'morph object))
-         (morph-text (bible--lookup-morph-entry morph)))
+         (morph-text (and morph (bible--lookup-morph morph))))
     (when lex-text
     (when lex-text
-      ;; 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.
-      ;; REVIEW: I couldn't figure out a better way to bypass command
-      ;;         substitution in the tooltips. (FMG 5-Mar-2026)
-      (subst-char-in-string
-       ?\\
-       ?
-       (if morph-text
-           (concat (string-trim lex-text) "\n" (string-trim morph-text))
-         (string-trim lex-text))))))
+      (setq lex-text 
+            (if morph-text
+                (concat (string-trim lex-text) "\n" (string-trim morph-text))
+              (string-trim lex-text)))
+      ;; Don't try to do command substitution in tooltip.
+      (put-text-property 0 1 'help-echo-inhibit-substitution t lex-text)
+      lex-text)))
 
 
 
 
 ;;;; Display module text
 ;;;; Display module text
@@ -1465,17 +1463,14 @@ in buffer)."
               (put-text-property start end 'strong matched))))
               (put-text-property start end 'strong matched))))
         ;; morphology
         ;; morphology
         (when morph
         (when morph
-          (let* ((matched nil)
-                 (morphemes (split-string morph))
+          (let* ((morphemes (split-string morph))
                  (morpheme (car (last morphemes)))) ; KJV kludge as above
                  (morpheme (car (last morphemes)))) ; KJV kludge as above
-            (if (or
-                 (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)))
-            (when matched
+            (when (or
+                   (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 bible-has-morphemes " Morph")
               (setq bible-has-morphemes " Morph")
-              (put-text-property start end 'morph matched)
+              (put-text-property start end 'morph  (match-string 0 morpheme))
               (put-text-property start end 'help-echo 'bible--show-lex-morph))))
               (put-text-property start end 'help-echo 'bible--show-lex-morph))))
         ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
         ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
         ;; TODO: Should I enable lexicon lookups on these lemmas? I
         ;; TODO: Should I enable lexicon lookups on these lemmas? I
@@ -1757,12 +1752,8 @@ If optional argument VERSE is supplied, set cursor at verse."
       (while (re-search-forward "  *" nil t) ; More than one space in a row
       (while (re-search-forward "  *" nil t) ; More than one space in a row
         (just-one-space)))
         (just-one-space)))
     ;; Set the mode line of the biffer.
     ;; Set the mode line of the biffer.
-    (if bible-has-lexemes
-        (unless (string-match " Lex" mode-name) (setq mode-name (concat mode-name " Lex")))
-      (setq mode-name (replace-regexp-in-string " Lex" "" mode-name)))
-    (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-local bible-lex (when bible-has-lexemes " Lex"))
+    (setq-local bible-morph (when bible-has-morphemes " Morph"))
     (force-mode-line-update))
     (force-mode-line-update))
     ;; If optional verse specification go to that verse.
     ;; If optional verse specification go to that verse.
   (when verse 
   (when verse