소스 검색

Fix setting Lex and Morph mode line indicators.

Fred Gilham 1 주 전
부모
커밋
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 (if bible--synced-p "Sync" ""))
     (: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 format for bible buffers.")
 
@@ -664,6 +664,9 @@ to all of them.")
 
 ;;;;; Lexemes / morphemes
 
+(defvar-local bible-lex nil)
+(defvar-local bible-morph nil)
+
 (defvar-local bible-term-language nil
   "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.
 Return hash table entry if present in `lex-hash' cache, else look up in
 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.
 Return hash table entry if present in `morph-hash' cache, else look up in
 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
 (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,
 otherwise just get lex definition."
   (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-text (bible--lookup-morph-entry morph)))
+         (morph-text (and morph (bible--lookup-morph morph))))
     (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
@@ -1465,17 +1463,14 @@ in buffer)."
               (put-text-property start end 'strong matched))))
         ;; morphology
         (when morph
-          (let* ((matched nil)
-                 (morphemes (split-string morph))
+          (let* ((morphemes (split-string morph))
                  (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")
-              (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))))
         ;; Insert lemma into buffer. Lemma tag will be part of lemma/savelm item.
         ;; 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
         (just-one-space)))
     ;; 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))
     ;; If optional verse specification go to that verse.
   (when verse