Browse Source

Fix one of the places where the module name is removed from buffer

Fred Gilham 2 weeks ago
parent
commit
eced6fe890
1 changed files with 52 additions and 37 deletions
  1. 52 37
      bible.el

+ 52 - 37
bible.el

@@ -381,12 +381,16 @@ See `bible--display-lemma-hebrew'."
 
 ;;;;; Term display
 
-(defconst bible-term-hebrew-mode-map (make-sparse-keymap))
-(define-key bible-term-hebrew-mode-map "z" 'text-scale-adjust)
+(defconst bible-term-mode-map (make-sparse-keymap))
+(define-key bible-term-mode-map "z" 'text-scale-adjust)
+(define-key bible-term-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
-(defconst bible-term-greek-mode-map (make-sparse-keymap))
-(define-key bible-term-greek-mode-map "z" 'text-scale-adjust)
-(define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)
+;;(defconst bible-term-hebrew-mode-map (make-sparse-keymap))
+;;(define-key bible-term-hebrew-mode-map "z" 'text-scale-adjust)
+
+;;(defconst bible-term-greek-mode-map (make-sparse-keymap))
+;;(define-key bible-term-greek-mode-map "z" 'text-scale-adjust)
+;;(define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
 ;;;;; Navigation
 
@@ -556,23 +560,25 @@ This command is run by clicking on text, not directly by the user."
   (setq buffer-read-only t)
   (visual-line-mode t))
 
-(define-derived-mode bible-term-hebrew-mode special-mode "Bible Term (Hebrew)"
-  "Mode for researching Hebrew terms in the Bible.
-\\{bible-term-hebrew-mode-map}"
+
+
+(define-derived-mode bible-term-mode special-mode "Bible Term"
+  "Mode for researching terms in the Bible.
+\\{bible-term-mode-map}"
   (buffer-disable-undo)
   (font-lock-mode t)
-  (use-local-map bible-term-hebrew-mode-map)
+  (use-local-map bible-term-mode-map)
   (setq buffer-read-only t)
   (visual-line-mode t))
 
-(define-derived-mode bible-term-greek-mode special-mode "Bible Term (Greek)"
+
+(define-derived-mode bible-term-hebrew-mode bible-term-mode "Bible Term (Hebrew)"
+  "Mode for researching Hebrew terms in the Bible.
+\\{bible-term-hebrew-mode-map}")
+
+(define-derived-mode bible-term-greek-mode bible-term-mode "Bible Term (Greek)"
   "Mode for researching Greek terms in the Bible.
-\\{bible-term-greek-mode-map}"
-  (buffer-disable-undo)
-  (font-lock-mode t)
-  (use-local-map bible-term-greek-mode-map)
-  (setq buffer-read-only t)
-  (visual-line-mode t))
+\\{bible-term-greek-mode-map}")
 
 (define-derived-mode bible-module-select-mode special-mode "Select Text Module"
   (buffer-disable-undo)
@@ -739,6 +745,7 @@ Handle abbreviations from lexicon module (AbbottSmith)."
          book
          chapter
          verse)
+    (message "Trying to follow %s" xref)
     (cond ((= (length verse-ref) 2) ; Mat 5 or the like
            (setq book-abbrev (car verse-ref)
                  chapter-verse (split-string (cadr verse-ref) ":")))
@@ -838,6 +845,9 @@ MODULE is the text module to use and defaults to the current module."
   "Text preceding start of chapter.
 Mostly in Psalms, like `Of David' or the like.")
 
+(defvar-local bible-level "0"
+  "Used by some modules for indentation and line breaks.")
+
 ;;;; Greek and Hebrew lexeme and morpheme tooltip rendering.
 
 ;;;;; Hash tables for Lexical definitions.
@@ -1187,7 +1197,6 @@ in buffer)."
               (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)
@@ -1199,8 +1208,6 @@ Since each verse will have a `title' tag, keep track and only emit a
 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)
-;;    (unless bible-chapter-title
-;;      (goto-char (point-min)))
     (setq-local bible-chapter-title title-node)
     (let ((title-text (bible-dom-texts bible-chapter-title)))
       (let ((refstart (point))
@@ -1212,6 +1219,23 @@ stored in `bible-chapter-title'."
 	(setq refend (point))
 	(put-text-property refstart refend 'face 'bold)))))
 
+;; These tags appear in ESV modules (and maybe others?)
+;; REVIEW: Is this right? (FMG 5-Mar-2026)
+(defun bible--level-tag (node)
+  "Indent or break line as dictated by NODE."
+  (let ((type (dom-attr node 'type))
+	(level (dom-attr node 'level)))
+    (cond ((and type (string-equal-ignore-case type "x-br"))
+	   (newline))
+          ((and type (string-equal-ignore-case type "x-indent"))
+           (insert "\t"))
+	  ;; REVIEW: Some modules use `level' tag but
+	  ;; not in a consistent way. (FMG 7-Mar-2026)
+	  ((equal level "1")
+	   (insert " "))
+          ((equal level "2")
+	   (newline)))))
+
 (defun bible--insert-domnode-recursive (node &optional iproperties)
   "Recursively parse domnode NODE obtained from `libxml-parse-html-region'.
 Inserts resulting text into active buffer with properties specified in
@@ -1243,7 +1267,9 @@ In processing subnodes, each case will prepend a space if it needs it."
 		;; talking about YOU, Psalm 119.
 		(if bible-chapter-title 
 		    (bible--insert-title subnode) ; Middle of chapter.
-		  (save-excursion (goto-char (point-min)) (bible--insert-title subnode)))) ; Beginning of chapter.
+		  (save-excursion
+		    (goto-char (point-min))
+		    (bible--insert-title subnode)))) ; Beginning of chapter.
 	       ;; Font tag should be ignored, treat as if 'w
                ('font (insert " ") (bible--process-word subnode iproperties))
                ('hi (when (equal (dom-attr subnode 'type) "bold")
@@ -1258,20 +1284,7 @@ In processing subnodes, each case will prepend a space if it needs it."
                ;; '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))
-               ;; These tags appear in ESV modules (and maybe others?)
-               ;; REVIEW: Is this right? (FMG 5-Mar-2026)
-               ('l
-                (let ((attributes (dom-attributes subnode)))
-                  (cond ((equal (dom-attr subnode 'type) "x-br")
-                         (bible-new-line))
-                        ((equal (dom-attr subnode 'type) "x-indent")
-                         (insert "\t"))
-                        ((dom-attr subnode 'level)
-                         (let ((indent (string-to-number (alist-get 'level attributes))))
-			   ;; REVIEW: Some modules use `level' tag but
-			   ;; not in a consistent way. (FMG 7-Mar-2026)
-                           (cond ((= indent 1) (insert " "))
-                                 ((= indent 2) (bible-new-line) (insert "\t\t"))))))))
+               ('l (bible--level-tag subnode))
 	       ;; REVIEW: divine name handling doesn't seem to work the same
 	       ;;         with all modules.
 	       ('divinename (bible-handle-divine-name subnode))
@@ -1288,9 +1301,10 @@ In processing subnodes, each case will prepend a space if it needs it."
                   (let ((start (point)))
                     (insert " " word)
                     (let ((end (point)))
+		      (message "crossreferencing %s" (buffer-substring start end))
                       (put-text-property start end 'xref word)
-                      (put-text-property start end 'keymap bible-search-mode-map)
-                      (put-text-property start end 'help-echo (concat "Go to " word " (doesn't work yet)"))
+                      (put-text-property start end 'keymap bible-term-greek-mode-map)
+                      (put-text-property start end 'help-echo (concat "Go to " word " (incomplete feature)"))
                       (add-face-text-property start end '(:foreground "blue"))))))
                ;; Various text properties---ignore for now
                ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties))
@@ -1471,8 +1485,9 @@ If optional argument VERSE is supplied, set cursor at verse."
       (erase-buffer)
       (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil))
     (goto-char (point-min))
+    ;; Remove module name from buffer.
     (save-excursion
-      (while (re-search-forward (concat "^.*" module) nil t)
+      (while (re-search-forward (concat "^.*" module ".*$") nil t)
         (replace-match ""))))
   (setq mode-name (concat "Bible Search (" module))
   (when bible-search-range