Bladeren bron

Fix, cleanup search, add mode-line-format

Fred Gilham 1 week geleden
bovenliggende
commit
c1f0edbbab
1 gewijzigde bestanden met toevoegingen van 70 en 25 verwijderingen
  1. 70 25
      bible.el

+ 70 - 25
bible.el

@@ -226,13 +226,24 @@ to all of them.")
 (defvar bible-mode-line-format
   '("%e" mode-line-front-space
     mode-line-frame-identification mode-line-buffer-identification "   "
+    bible-text
+    "  "
     bible--current-book-name
-    " " (:eval (number-to-string bible--current-chapter))
+    " "  (:eval (number-to-string bible--current-chapter))
     "  " (:eval (if bible--synced-p "Sync" ""))
     "  " mode-line-modes mode-line-misc-info
     mode-line-end-spaces)
   "Mode line format for bible buffers.")
 
+(defvar bible-search-mode-line-format
+  '("%e" mode-line-front-space
+    mode-line-frame-identification mode-line-buffer-identification "   "
+    bible-text " " bible-search-word " "
+    (:eval (number-to-string bible-search-matches)) " matches"
+    "  " mode-line-modes mode-line-misc-info
+    mode-line-end-spaces)
+  "Mode line format for bible search buffers.")
+
 (defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
 
 (defvar bible--texts (lazy-completion-table bible--texts bible--list-biblical-texts))
@@ -487,8 +498,8 @@ 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-xref)
-(define-key bible-search-mode-map [mouse-1] 'bible-search-mode-follow-xref)
+(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)
 
 ;;;;; Term display
 
@@ -624,7 +635,7 @@ This command is run by clicking on text, not directly by the user."
   (use-local-map bible-map)
   (setq buffer-read-only t)
   (visual-line-mode t))
-
+ 
 (define-derived-mode bible-search-mode special-mode "Bible Search"
   "Mode for performing Bible searches.
 \\{bible-search-mode-map}"
@@ -824,6 +835,24 @@ 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)
+    (when (string-match bible--verse-regexp text)
+      (setq text (match-string 0 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.
@@ -833,7 +862,8 @@ Handle abbreviations."
          (verse-ref (split-string xref))
          book-abbrev
          chapter-verse)
-;;    (message "Trying to follow %s" xref)
+    (message "xref: %s" xref)
+    (message "Verse-ref: %s" verse-ref)
     (cond ((= (length verse-ref) 2) ; Mat 5 or the like
            (setq book-abbrev (car verse-ref)
                  chapter-verse (split-string (cadr verse-ref) ":")))
@@ -1277,7 +1307,7 @@ in buffer)."
 
 (defun bible-new-line ()
   "Ensure beginning of line.  Try to avoid redundant blank lines."
-  (unless (= (current-column) 0)
+  (unless (bolp)
     (newline)))
 
 (defun bible--insert-title (title-node)
@@ -1297,7 +1327,8 @@ stored in `bible-chapter-title'."
       ;; This is necessary in the KJV module when displaying psalm 119.
       (insert (string ?\x200e) title-text)
       (put-text-property start (point) 'face 'bold)
-      (newline))))
+      (newline)
+      (delete-blank-lines))))
 
 ;; These tags appear in ESV modules (and maybe others?)
 ;; REVIEW: Is this right? (FMG 5-Mar-2026)
@@ -1314,7 +1345,8 @@ stored in `bible-chapter-title'."
 	  ((equal level "1")
 	   (just-one-space))
           ((equal level "2")
-	   (newline)))))
+	   (newline)
+	   (delete-blank-lines)))))
 
 
 (defun bible--insert-xref (node)
@@ -1323,8 +1355,9 @@ stored in `bible-chapter-title'."
 ;; TODO: Fix punctuation. (FMG 25-Mar-2026)
   (let* ((word (bible-dom-text node))
 	 (refs (split-string word ";" t)))
-    (message "refs %s" refs)
+    (message "ref-word: %s" word)
     (dolist (ref refs)
+      (message "ref %s" ref)
       (just-one-space)
       (let ((start (point)))
 	(insert ref)
@@ -1445,10 +1478,6 @@ If optional argument VERSE is supplied, set cursor at verse."
 	  ;;          (when (re-search-forward "^ *[0-9]+" nil t 1)
 	  (when (re-search-forward " *[0-9]+:" nil t 1)
             (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple"))))))
-    (save-excursion
-      ;; Remove the module name from the buffer.
-      (while (re-search-forward (concat "^.*" bible-text ".*$") nil t)
-        (replace-match "" nil t)))
     (save-excursion
       ;; Fix divine name lossage.
       (while (re-search-forward "Lord LORD" nil t)
@@ -1456,7 +1485,10 @@ If optional argument VERSE is supplied, set cursor at verse."
 	(add-face-text-property (point) (- (point) 4) 'bold))
       (while (re-search-forward "Lord.+s LORD" nil t -1)
 	(replace-match "LORD's")
-	(add-face-text-property (1- (point)) (- (point) 5) 'bold)))
+	(add-face-text-property (1- (point)) (- (point) 5) 'bold))
+      ;; Remove the module name from the buffer.
+      (while (re-search-forward (concat "^.*" bible-text ".*$") nil t)
+        (replace-match "" nil t)))
     (save-excursion
       (format-replace-strings '(("." . ". ")
                                 ("," . ", ")
@@ -1479,9 +1511,16 @@ 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 " ")))
+;;        (replace-match " ")))
+        (just-one-space)))
     ;; Set the mode line of the biffer.
-    (setq mode-name (concat bible-text (when bible-has-lexemes " Lex") (when bible-has-morphemes " Morph")))
+    (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 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
@@ -1493,7 +1532,6 @@ If optional argument VERSE is supplied, set cursor at verse."
   "Compare N1 and N2, ignoring case, using collation order."
   (string-collate-lessp n1 n2 nil t))
 
-
 (defun bible--get-biblical-modules ()
   "Populate `bible--texts' and `bible--commentaries' lists."
   (let ((lines 
@@ -1590,6 +1628,10 @@ If optional argument VERSE is supplied, set cursor at verse."
 
 ;;;; Bible Searching
 
+(defvar-local bible-search-word "")
+(defvar-local bible-search-module "")
+(defvar-local bible-search-matches 0)
+
 (defun bible--open-search (query searchmode module)
   "Open a search buffer of QUERY using SEARCHMODE in module MODULE."
   (let ((results (string-trim (replace-regexp-in-string
@@ -1600,9 +1642,11 @@ 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-" (downcase module) "-" query "*"))
+      (with-current-buffer (get-buffer-create (concat "*bible-search*"))
         (bible-search-mode)
-        (bible--display-search results module)
+	(bible--display-search results module)
+	(setq-local bible-search-word query
+		    bible-search-module module)
         (pop-to-buffer (current-buffer) nil t)))))
 
 (defun bible--display-search (results module)
@@ -1612,7 +1656,8 @@ If optional argument VERSE is supplied, set cursor at verse."
         (verses nil)
         (query-verses "")
         (buffer-read-only nil))
-;;    (message "display-search %s" module)
+    ;;    (message "display-search %s" module)
+    (setq-local mode-line-format bible-search-mode-line-format)
     (setq-default bible-text module)
     (erase-buffer)
     (while match
@@ -1645,11 +1690,11 @@ If optional argument VERSE is supplied, set cursor at verse."
     ;; Remove module name from buffer.
     (save-excursion
       (while (re-search-forward (concat "^.*" module ".*$") nil t)
-        (replace-match ""))))
-  (setq mode-name (concat "Bible Search (" module))
-  (when bible-search-range
-    (setq mode-name (concat mode-name " <" bible-search-range ">")))
-  (setq mode-name (concat mode-name ")")))
+        (replace-match "")))
+    (setq mode-name "Bible Search ")
+    (when bible-search-range 
+      (setq mode-name (concat mode-name " <" bible-search-range ">")))
+    (setq-local bible-search-matches (length verses))))
 
 
 ;;;; Terms (lemmas, morphemes)