Browse Source

Clean up accumulated cruft and make code more idiomatic.

Fred Gilham 1 tuần trước cách đây
mục cha
commit
f9ba133cdc
1 tập tin đã thay đổi với 92 bổ sung88 xóa
  1. 92 88
      bible.el

+ 92 - 88
bible.el

@@ -487,8 +487,6 @@ to all of them.")
 (define-key bible-search-mode-map "w" 'bible-toggle-word-study)
 (define-key bible-search-mode-map "n" 'bible-next-search-item)
 (define-key bible-search-mode-map "p" 'bible-previous-search-item)
-;;(define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-verse)
-;;(define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-verse)
 (define-key bible-search-mode-map (kbd "RET") 'bible-search-mode-follow-xref)
 (define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
@@ -683,6 +681,8 @@ specifies the module to use."
     (cl-pushnew (current-buffer) bible--text-buffers)
     (set-window-buffer (get-buffer-window (current-buffer)) (current-buffer))))
 
+;;;;;; Navigation
+
 (defun bible-next-chapter ()
   "Page to the next chapter for the active `bible' buffer and 
 for any synchronized buffers."
@@ -691,7 +691,6 @@ for any synchronized buffers."
          (chapter (min book-chapters (1+ bible--current-chapter))))
     (bible--set-location bible--current-book chapter)))
 
-
 (defun bible-previous-chapter ()
   "Page to the previous chapter for the active `bible' buffer and
 for any synchronized buffers."
@@ -714,6 +713,8 @@ for any synchronized buffers."
       (when previous-change
         (goto-char (prop-match-beginning previous-change))))))
 
+;;;;;; Select Location
+
 (defun bible-select-book ()
   "Ask user for a new book and chapter for the current `bible' buffer."
   (interactive)
@@ -741,13 +742,14 @@ for any synchronized buffers."
     (when chapter
       (bible--set-location bible--current-book chapter))))
 
-(defun bible-set-search-range ()
-  "Ask user for a new text module for the current `bible' buffer."
+;;;;;; Select modules
+
+;; Choose a module.
+(defun bible-pick-module ()
+  "Keymap action function---select module that the user chooses."
   (interactive)
-  (let ((range (read-string "Range (<return> to clear): ")))
-    (if (string-equal range "")
-        (setq bible-search-range nil)
-      (setq bible-search-range range))))
+  (let ((item (get-text-property (point) 'module)))
+    (bible-open bible--current-book-name bible--current-chapter 1 item)))
 
 (defun bible-select-text ()
   "Ask user for a new text module for the current `bible' buffer."
@@ -766,6 +768,8 @@ for any synchronized buffers."
       (setq-local bible-text commentary)
       (bible--display))))
 
+;;;;;; Toggles
+
 (defun bible-toggle-word-study ()
   "Toggle the inclusion of word study for the active `bible' buffer."
   (interactive)
@@ -778,14 +782,6 @@ for any synchronized buffers."
   (setq bible-red-letter-enabled (not bible-red-letter-enabled))
     (bible--display))
 
-(defun bible-split-display ()
-  "Copy the active `bible' buffer into a new buffer in another window."
-  (interactive)
-  (split-window-right)
-  (balance-windows)
-  (other-window 1)
-  (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
-
 (defun bible-toggle-buffer-sync ()
   "Either add or remove the current buffer from the
 `bible--synced-buffers' list."
@@ -799,6 +795,24 @@ for any synchronized buffers."
       (setq-local bible--synced-p t))
     (force-mode-line-update)))
 
+(defun bible-split-display ()
+  "Copy the active `bible' buffer into a new buffer in another window."
+  (interactive)
+  (split-window-right)
+  (balance-windows)
+  (other-window 1)
+  (bible-open bible--current-book-name bible--current-chapter 1 bible-text))
+
+;;;;;; Search helpers
+
+(defun bible-set-search-range ()
+  "Ask user for a new text module for the current `bible' buffer."
+  (interactive)
+  (let ((range (read-string "Range (<return> to clear): ")))
+    (if (string-equal range "")
+        (setq bible-search-range nil)
+      (setq bible-search-range range))))
+
 (defun bible-search (query)
   "Search for a QUERY: a word or phrase.
 Asks the user for type of search: either `lucene', `phrase', `regex'
@@ -810,25 +824,6 @@ or `multiword'.  `lucene' is the default search.
     (let ((searchmode (completing-read "Search Mode: " '("lucene" "phrase" "regex" "multiword") nil t "lucene")))
       (bible--open-search query searchmode (buffer-local-value 'bible-text (current-buffer))))))
 
-(defun bible-search-mode-follow-verse ()
-  "Follow the hovered verse in a `bible-search-mode' buffer.
-Create a new `bible' buffer positioned at the selected verse."
-  (interactive)
-  (let* ((text (thing-at-point 'line t))
-         book
-         chapter
-         verse)
-    (string-match bible--verse-regexp text)
-    (setq text (match-string 0 text))
-    (message "Text match is %s" text)
-    (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
-    (setq book (match-string 0 text))
-    (string-match "[0-9]?[0-9]?[0-9]?:" text)
-    (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
-    (string-match ":[0-9]?[0-9]?[0-9]?" text)
-    (setq verse (substring (match-string 0 text) 1))
-    (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse)) bible-text))
-
 (defun bible-search-mode-follow-xref ()
   "Follow the hovered verse in a bible term buffer.
 Create a new `bible' buffer positioned at the specified verse.
@@ -851,6 +846,9 @@ Handle abbreviations."
           (verse (cadr chapter-verse)))
       (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse) (default-value 'bible-text)))))
 
+
+;;;;;; User visible actions.
+
 ;; These can be called interactively if you know the Strong's number
 ;; you want to look up.
 
@@ -876,14 +874,8 @@ Handle abbreviations."
          (args (list bible-sword-query nil (current-buffer) t "-b" bible-text "-f" "plain" "-k" query)))
     (apply #'call-process args)))
 
-;; Choose a Bible text.
-(defun bible-pick-module ()
-  "Keymap action function---select module user chooses."
-  (interactive)
-  (let ((item (get-text-property (point) 'module)))
-    (bible-open bible--current-book-name bible--current-chapter 1 item)))
 
-;;;; Support (internal)
+;;;;;; Support (internal)
 
 ;; Don't know how to get footnotes and scripture cross references yet.
 ;;(defconst bible-diatheke-filter-options " afilmnsvw")
@@ -1195,15 +1187,15 @@ both tags, otherwise just get lex definition."
 
 (defun bible-handle-divine-name (item)
   "When ITEM is divine name, display it as such."
-  (insert "LORD")
-  (let* ((refstart (- (point) (length "LORD")))
-         (refend (point))
-         (strongs (dom-attr item 'savlm)))
-    (add-face-text-property refstart refend 'bold)
-    (put-text-property refstart refend 'keymap bible-hebrew-keymap)
-    (when (and strongs (string-match "strong:H" strongs))
-      (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
-      (put-text-property refstart refend 'strong (match-string 0 strongs)))))
+  (let ((start (point))
+	(strongs (dom-attr item 'savlm)))
+    (insert "LORD")
+    (let ((end (point)))
+      (add-face-text-property start end 'bold)
+      (put-text-property start end 'keymap bible-hebrew-keymap)
+      (when (and strongs (string-match "strong:H" strongs))
+	(put-text-property start end 'help-echo 'bible--show-lex-morph)
+	(put-text-property start end 'strong (match-string 0 strongs))))))
 
 
 (defun bible--process-word (item iproperties)
@@ -1216,8 +1208,8 @@ in buffer)."
         (savlm (dom-attr item 'savlm))
         (lemma (dom-attr item 'lemma))
         (divinename (dom-by-tag item 'divinename)))
-    (let ((refstart (point))
-          (refend (+ (point) (length word))))
+    (let ((start (point))
+          (end (+ (point) (length word))))
       (insert word)
       ;; REVIEW: Special case this. Some modules do this differently.
       ;;         (FMG 5-Mar-2026)
@@ -1227,7 +1219,7 @@ in buffer)."
 	(just-one-space))
       ;; Red letter.
       (when (plist-get iproperties 'jesus)
-        (add-face-text-property refstart refend '(:foreground "red")))
+        (add-face-text-property start end '(:foreground "red")))
       ;; lexical definitions
       ;; N.B. There are some severe issues with Strongs numbers in some modules.
       (when (or savlm lemma)
@@ -1248,15 +1240,15 @@ in buffer)."
           (when lexeme
             (cond ((string-match "strong:G.*" lexeme) ; Greek
                    (setq matched (match-string 0 lexeme))
-                   (put-text-property refstart refend 'keymap bible-greek-keymap))
+                   (put-text-property start end 'keymap bible-greek-keymap))
                   ((string-match "strong:H.*" lexeme) ; Hebrew
                    (setq matched (match-string 0 lexeme))
-                   (put-text-property refstart refend 'keymap bible-hebrew-keymap)))
+                   (put-text-property start end 'keymap bible-hebrew-keymap)))
             ;; Add help-echo, strongs reference for tooltips if match.
             (when matched
               (setq bible-has-lexemes " Lex")
-              (put-text-property refstart refend 'help-echo 'bible--show-lex-morph)
-              (put-text-property refstart refend 'strong matched))))
+              (put-text-property start end 'help-echo 'bible--show-lex-morph)
+              (put-text-property start end 'strong matched))))
         ;; morphology
         (when morph
           (let* ((matched nil)
@@ -1269,23 +1261,24 @@ in buffer)."
                 (setq matched (match-string 0 morpheme)))
             (when matched
               (setq bible-has-morphemes " Morph")
-              (put-text-property refstart refend 'morph matched)
-              (put-text-property refstart refend 'help-echo 'bible--show-lex-morph))))
+              (put-text-property start end 'morph matched)
+              (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
         ;;       don't use this anyway.... (FMG 5-Mar-2026)
         (when (and bible-word-study-enabled lemma (string-match "lemma.*:.*" lemma))
           (dolist (word (split-string (match-string 0 lemma) " "))
             (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
+	    (just-one-space)
             (let ((refstart (point)))
-              (insert " " word)
+              (insert word)
               (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 (= (current-column) 0)
-    (insert "\n")))
+    (newline)))
 
 (defun bible--insert-title (title-node)
   "Insert the text in TITLE-NODE into buffer as a chapter title. 
@@ -1294,15 +1287,17 @@ title when the new title in `title-node' is different from the one
 stored in `bible-chapter-title'."
   (unless (equal bible-chapter-title title-node)
     (setq-local bible-chapter-title title-node)
-    (let ((title-text (bible-dom-texts bible-chapter-title)))
-      (let ((refstart (point))
-	    refend)
-	(setf title-text (replace-regexp-in-string "<.*?>" "" title-text))
-	(bible-new-line)
-	(insert (bidi-string-mark-left-to-right title-text))
-	(bible-new-line)
-	(setq refend (point))
-	(put-text-property refstart refend 'face 'bold)))))
+    (let ((title-text 
+	   (replace-regexp-in-string ; Clear out XML.
+	    "<.*?>" ""
+	    (bible-dom-texts bible-chapter-title)))
+	  (start (point)))
+      (bible-new-line)
+      ;; Insert the LRM character to make the text render left-to-right.
+      ;; This is necessary in the KJV module when displaying psalm 119.
+      (insert (string ?\x200e) title-text)
+      (put-text-property start (point) 'face 'bold)
+      (newline))))
 
 ;; These tags appear in ESV modules (and maybe others?)
 ;; REVIEW: Is this right? (FMG 5-Mar-2026)
@@ -1317,17 +1312,22 @@ stored in `bible-chapter-title'."
 	  ;; REVIEW: Some modules use `level' tag but
 	  ;; not in a consistent way. (FMG 7-Mar-2026)
 	  ((equal level "1")
-	   (insert " "))
+	   (just-one-space))
           ((equal level "2")
 	   (newline)))))
 
+
 (defun bible--insert-xref (node)
+  "Insert a cross reference specified by NODE."
+;; TODO: Finish handling multiple consecutive cross references. (FMG 25-Mar-2026)
+;; TODO: Fix punctuation. (FMG 25-Mar-2026)
   (let* ((word (bible-dom-text node))
 	 (refs (split-string word ";" t)))
     (message "refs %s" refs)
     (dolist (ref refs)
+      (just-one-space)
       (let ((start (point)))
-	(insert " " ref ";")
+	(insert ref)
 	(let ((end (point)))
 	  (put-text-property start end 'xref ref)
 	  (put-text-property start end 'keymap bible-term-mode-map)
@@ -1371,14 +1371,18 @@ In processing subnodes, each case will prepend a space if it needs it."
 	       ;; Font tag should be ignored, treat as if 'w
                ('font (insert " ") (bible--process-word subnode iproperties))
                ('hi (when (equal (dom-attr subnode 'type) "bold")
-                      (let ((word (bible-dom-text subnode)))
-                        (insert " " word)
-                        (put-text-property (- (point) (length word)) (point) 'face 'bold))))
+		      (just-one-space)
+                      (let ((word (bible-dom-text subnode))
+			    (start (point)))
+                        (insert word)
+                        (put-text-property start (point) 'face 'bold))))
                ('i ; Italic face (special case for certain module)
-                (let ((word (bible-dom-text subnode)))
-                  (insert " " word)
-                  (put-text-property (- (point) (length word)) (point) 'face 'bold)
-                  (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
+		(just-one-space)
+                (let ((word (bible-dom-text subnode))
+		      (start (point)))
+                  (insert word)
+                  (put-text-property start (point) 'face 'bold)
+                  (add-face-text-property start (point) '(:foreground "orange"))))
                ;; 'q is used for red letter.
                ;; NASB Module uses 'seg to indicate OT quotations (and others?).
 	       ((or 'body 'seg 'p 'q) (bible--insert-domnode-recursive subnode iproperties))
@@ -1404,11 +1408,12 @@ In processing subnodes, each case will prepend a space if it needs it."
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
                ;; Word inserted by translation, not in original, give visual indication.
                ('transchange
-                (let ((word (bible-dom-text subnode)))
-                  (insert " " word)
-                  (if (plist-get iproperties 'jesus)
-                      (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
-                    (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
+		(insert " ")
+                (let ((word (bible-dom-text subnode))
+		      (start (point))
+		      (face (if (plist-get iproperties 'jesus) '(:foreground "salmon") '(:foreground "gray50"))))
+                  (insert word)
+                  (add-face-text-property start (point) face)))))))))
 
 (defun bible--display (&optional _module verse)
   "Render a page (chapter) of a Bible module.
@@ -1521,8 +1526,6 @@ If optional argument VERSE is supplied, set cursor at verse."
     (setq bible--commentaries (cl-sort commentaries #'compare-module-names :key #'car)))
   nil)
 
-
-
 (defun bible--list-biblical-texts ()
   "Return a list of accessible Biblical Text modules."
   (bible--get-biblical-modules) ; Make sure the lists are fresh.
@@ -1674,6 +1677,7 @@ If optional argument VERSE is supplied, set cursor at verse."
     ;;;              (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))