|
|
@@ -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
|