Fix a few things

- Use tabs to move through words
- Xrefs in term display

TODO

@@ -1,9 +1,10 @@
 #+COMMENT: -*- Mode: org -*-
-#+COMMENT: Time-stamp: <2024-05-22 09:23:25 fred>
+#+COMMENT: Time-stamp: <2024-06-25 09:45:39 fred>
 * DONE Make lookups be relative to the specified book, not to Genesis. (internal)
 * DONE Make tabs work in Hebrew mode
-* TODO Make tabs skip past verse number at the beginning
-  - Use `fields'
+* DONE Make tabs skip past verse number at the beginning
+  - Use `fields' 
+  - actually done by using text properties
 * DONE Make lookups be case insensitive in all contexts (e.g. module). This isn't applicable because modules have combinations of different cases (upper and lower)
 * DONE Cache module list on startup (lazy lookup instead)
 * DONE Make morphology work in word-study mode
@@ -19,9 +20,10 @@
 * DONE Some bugs in Hebrew rendering (occasional "args out of range" errors). (Fixed by changing the way text properties are done.)
 * DONE Fix titles (i.e. in Psalms) (Still broken)
   - Show lemmas in titles?
-* TODO Fix punctuation
+* DONE Fix punctuation
   - Have to parse XML.
   - ?? Probably lots of work for not much return
+  - Did by looking at dom tags.
 * TODO Infer chapter counts from book data
   - May not be easily possible
 * TODO Search should order references by OT books, then NT books, in alphabetical order
@@ -39,9 +41,9 @@
     Gender: Masculine
     though this may take up too much vertical space. But it looks like Emacs puts the tooltips in a good place.
   - Did this by using "shr" package to parse HTML.
-* TODO Clean up Hebrew lexicon tooltip
+* DONE Clean up Hebrew lexicon tooltip
   - I.e. outline indicators should be better indented.
-* TODO Cross references in Abbott lexicon display are not right
+* DONE Cross references in Abbott lexicon display are not right
   - I.e. Mk 3:7, 4:11, 15; should refer to Mark 3:7, Mark 4:11 and Mark 4:15.
     Do this with overlapping text properties.
     

bible-mode.el

@@ -1,7 +1,7 @@
 ;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
 ;;
 ;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI
-;; Time-stamp: <2024-06-19 16:02:32 fred>
+;; Time-stamp: <2024-06-25 09:41:37 fred>
 
 ;; Author: Zacalot
 ;; Fixes and modifications by Fred Gilham
@@ -279,7 +279,8 @@ which are of the form
 	    [menu-bar bible-mode previous-chapter]
 	    '("Previous Chapter" . bm-previous-chapter))
 
-(define-key bm-map (kbd "TAB") 'bm-forward-word) ; TODO: bm-forward-word
+(define-key bm-map (kbd "TAB") 'bm-next-word)
+(define-key bm-map (kbd "M-<tab>") 'bm-previous-word)
 
 ;;;;; Direct jump
 (define-key bm-map "b" 'bm-select-book)
@@ -319,25 +320,27 @@ which are of the form
 (define-key bm-map "\C-n" 'next-logical-line)
 (define-key bm-map "\C-p" 'previous-logical-line)
 
+(defun bm-next-search-item ()
+  (interactive)
+  (search-forward-regexp bm-verse-regexp))
+
+(defun bm-previous-search-item ()
+  (interactive)
+  (search-backward-regexp bm-verse-regexp))
+
+
 (defconst bible-search-mode-map (make-keymap))
 (define-key bible-search-mode-map "s" 'bible-search)
 (define-key bible-search-mode-map "w" 'bm-toggle-word-study)
+(define-key bible-search-mode-map "n" 'bm-next-search-item)
+(define-key bible-search-mode-map "p" 'bm-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-xref)
 
 (defconst bible-term-hebrew-mode-map (make-sparse-keymap))
 (defconst bible-term-greek-mode-map (make-sparse-keymap))
-;; (defconst bible-term-morph-mode-map (make-keymap))
-
-
-(defun bible-term-mode-follow-xref ()
-  (message "Bible term mode follow xref"))
-  
-
 
 (define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
-
 ;;;
 ;;; Menu bar items
 ;;;
@@ -354,9 +357,6 @@ which are of the form
 (defvar-local bm-debugme nil
   "Make text show up as XML when set.")
 
-
-
-
 (defvar use-tooltips t)
 
 (defun bm-toggle-tooltips ()
@@ -500,11 +500,25 @@ which are of the form
   (bm--set-location bm-current-book (max 1 (- bm-current-chapter 1))))
 
 
-(defun bm-forward-word ()
-  "Moves forward a word, taking into account the relevant text properties.
-XXX Doesn't work yet."
+(defun bm-next-word ()
+  "Moves forward a word, taking into account the relevant text 
+properties."
+  (interactive)
+  (unless (eobp)
+    (let ((plist (text-properties-at (point)))
+          (next-change (text-property-search-forward 'strong nil nil t)))
+      (when next-change
+	(goto-char (1- (prop-match-end next-change)))))))
+
+(defun bm-previous-word ()
+  "Moves forward a word, taking into account the relevant text 
+properties."
   (interactive)
-  (field-end))
+  (unless (bobp)
+    (let ((plist (text-properties-at (point)))
+          (previous-change (text-property-search-backward 'strong)))
+      (when previous-change
+	(goto-char (prop-match-beginning previous-change))))))
 
 
 
@@ -599,7 +613,6 @@ OT/NT etc."
 	 chapter-verse
 	 chapter
 	 verse)
-    (message "Following xref %s" xref)
     (if (= (length verse-ref) 3) ; II Cor 3:17 or the like
 	(progn
 	  (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref)))
@@ -610,7 +623,6 @@ OT/NT etc."
 
     ;;    (setq book (cdr (assoc book-abbrev bm-book-name-abbreviations-alist)))
     (setq book (car verse-ref))
-    (message "Xref is %s %s" book chapter-verse )
     (setq chapter (car chapter-verse)
 	  verse (cadr chapter-verse))
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
@@ -653,8 +665,8 @@ OT/NT etc."
     (with-temp-buffer
       (let ((args (list "diatheke" nil (current-buffer) t "-b" module)))
 	(if filter
-	    (setq filter (concat filter " avmws"))
-	    (setq filter "avmws"))
+	    (setq filter (concat filter " avlnmws"))
+	    (setq filter "avlmnws"))
 	(when filter (setq args (append args (list "-o" filter))))
 	(when searchtype
 	  (setq args (append args (list "-s" (pcase searchtype ("lucene" "lucene") ("phrase" "phrase"))))))
@@ -703,7 +715,6 @@ Does some tweaking specific to morphology."
       (substring (buffer-string) (+ (length query) 1))) ; This tries to get rid of unnecessary query identifier.
     ))
 
-
 ;;; Use "plain" format with diatheke.
 (defun bm--lex-query (query module)
   "Executes `diatheke' for query, plain format, returns string."
@@ -720,164 +731,92 @@ Does some tweaking specific to morphology."
 		 (bm--lex-query key bm-lexicon-index)))
 	       lemma-index-hash)))
 
+;;;
+;;; The Greek lexical definitions are done using the HTMLHREF output
+;;; format so they come out looking nice and having clickable
+;;; cross-references and/or Strong's references.
+	   
+(defun bm--process-href ()
+  "This fixes the XML so cross-references are in the right format. These
+cross-references get processed later when the term is displayed.
 
-;;;; (defun bm--lookup-def-by-greek-lemma (lemma)
-;;;;   "Executes `diatheke' to do query by lemma, sets text properties to allow
-;;;; verse cross references. Returns string. Note that this looks up by lemmas, 
-;;;; not Strong's numbers. The lemmas are retrieved from a Strong's number-to-lemma
-;;;; index (or possibly otherwise)."
-;;;;   (with-temp-buffer
-;;;;     (let ((args (list "diatheke" nil (current-buffer) t "-b" bm-greek-lexicon "-o" "m" "-f" "plain" "-k" lemma)))
-;;;;       (apply 'call-process args)
-;;;;       ;; Clean up outlining in the term buffer. Just fix the first
-;;;;       ;; level of outline. This is specific to the AbbottSmith module;
-;;;;       ;; it may help for other versions.
-;;;;       (format-replace-strings
-;;;;        '((" I." . "\n   I.")
-;;;; 	 (" 1." . "\n     1.")
-;;;; 	 (" (a)" . "\n        (a)")
-;;;; 	 (" (α)" . "\n          (α)")
-;;;; 	 ("      (i)" . "\n      (i)")
-;;;; 	 ("      (1)" . "\n      (1)")
-;;;; 	 (". ." . ".")
-;;;; 	 (" . " . ". ")))
-;;;;       (goto-char (point-min))
-;;;;       (while (search-forward "\n" nil t)
-;;;; 	(delete-blank-lines))
-;;;;       (goto-char (point-min))
-;;;;       ;; Highlight verse references to allow lookup from lexicon
-;;;;       ;; entry. XXX This is incomplete and does not handle all the
-;;;;       ;; types of cross-reference.
-;;;;       (while (search-forward-regexp bm-verse-regexp nil t)
-;;;; 	(put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
-;;;; 	(put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
-;;;; 	(add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue"))
-;;;; 	))
-;;;;     (buffer-string)))
-
-;;;; (defun bm--process-href ()
-;;;;   (cl-do* ((text (buffer-string))
-;;;; 	   (href-match (string-match "<a href=\"passagestudy.*?</a>" text) (string-match "<a href=\"passagestudy.*?</a>" text new-start))
-;;;; 	   (href-string (match-string 0 text) (match-string 0 text))
-;;;; 	   (new-start (match-end 0) (match-end 0)))
-;;;;       ((not href-match))
-;;;;     (let* ((value-match (string-match "value=.*?&" href-string))
-;;;; 	   (value-string (match-string 0 href-string))
-;;;; 	   (verse-ref-string (substring value-string 6 (1- (length value-string)))))
-;;;;       (set-text-properties (match-beginning 0) (match-end 0) nil)
-;;;;       (replace-regexp "<a href=\"passagestudy.*?</a>" verse-ref-string t href-match new-start)
-;;;;       (message "Replaced %s with %s" href-string verse-ref-string)
-;;;;       (put-text-property (match-beginning 0) (length verse-ref-string) 'xref (match-string 0))
-;;;;       (put-text-property (match-beginning 0) (length verse-ref-string) 'keymap bible-search-mode-map)
-;;;;       (add-face-text-property (match-beginning 0) (length verse-ref-string) '(:foreground "blue")))))
-
-;;;  (while (re-search-forward REGEXP nil t)
-;;;    (replace-match TO-STRING nil nil))
+First, find the links put in by diatheke's HTMLHREF output format.
+Replace the links with verse references that get changed to clickable
+cross-references when the term is displayed. 
 
+The verse refs look like this: <bookname>.<chapter>.<verse>. We convert
+them to the <bookname> <chapter>:<verse> format."
 
-	   
-(defun bm--process-href ()
   (goto-char (point-min))
-  (cl-do* ((href-match (re-search-forward "<a href=\"passagestudy.*?</a>" nil t) (re-search-forward "<a href=\"passagestudy.*?</a>" nil t))
-	   (match-text (match-string 0) (match-string 0)))
-      ((not href-match))
-    (replace-match "" nil nil)
-    (let* ((value-match (string-match "value=.*?&" match-text))
-	   (value-string (match-string 0 match-text))
-	   (verse-ref-string (substring value-string 6 (1- (length value-string))))
-	   (verse-ref-length (length verse-ref-string))
-	   (prefix-1 (seq-position verse-ref-string ?1))
-	   (prefix-2 (seq-position verse-ref-string ?2)))
-
-      (aset verse-ref-string (cl-search "." verse-ref-string) 32) ; Substitute first period with space
-      (aset verse-ref-string (cl-search "." verse-ref-string) 58) ; Substitute second period with colon
-
-      ;; Handle leading 1 or 2.
-      (when (and prefix-1 (= prefix-1 0))
-	(setq verse-ref-string (concat "I" (substring verse-ref-string 1))))
-      (when (and prefix-2 (= prefix-2 0))
-	(setq verse-ref-string (concat "II" (substring verse-ref-string 1))))
-
-      (message "verse-ref-string: %s; length %s; point %s" verse-ref-string (length verse-ref-string) (point))
-      (set-text-properties 0 verse-ref-length nil verse-ref-string)
-      (put-text-property 0 verse-ref-length 'xref verse-ref-string verse-ref-string)
-      (put-text-property 0 verse-ref-length 'keymap bible-search-mode-map verse-ref-string)
-      (add-face-text-property 0 (length verse-ref-string) '(:foreground "blue") nil verse-ref-string)
-      (insert verse-ref-string))))
-
-
-
-;;;; (string-match "[0-9]+" text) (string-match "[0-9]+" text (match-end 0))))
-;;;;       ((not match))
-;;;;     ;; This enables clicking on the Strong's numbers inside the term display.
-;;;;     (let* ((matchstr (match-string 0 text))
-;;;; 	   (matchstrlen (length matchstr))
-;;;;            (refstart (+ match 1))
-;;;;            (refend (+ match 1 matchstrlen)))
-;;;;       (cond ((eq termtype 'hebrew)
-;;;; 	     (put-text-property refstart refend 'strong (concat "strong:H" matchstr))
-;;;; 	     (put-text-property refstart refend 'keymap bm-hebrew-keymap)
-;;;; 	     (add-face-text-property refstart refend `(:foreground "blue")))
-;;;; 	    ((eq termtype 'greek)
-;;;; 	     (put-text-property refstart refend 'strong (concat "strong:G" matchstr))
-;;;; 	     (put-text-property refstart refend 'keymap bm-greek-keymap)
-;;;; 	     (add-face-text-property refstart refend `(:foreground "blue"))))))
-
-
-
-(defun bm--lookup-def-by-greek-lemma (lemma)
-  "Executes `diatheke' to do query by lemma, sets text properties to allow
-verse cross references. Returns string. Note that this looks up by lemmas, 
-not Strong's numbers. The lemmas are retrieved from a Strong's number-to-lemma
-index (or possibly otherwise)."
+
+  (while (re-search-forward "<a href=\"passagestudy.*?</a>" nil t) ; HTMLHREF cross references.
+
+    (let ((match-text (match-string 0)))
+
+      ;; Delete original link.
+      (replace-match "" nil nil)
+    
+      ;; Get the verse reference from the string we saved. Put it in
+      ;; good format, then insert it into buffer where href was.
+
+      (when (string-match "value=.*?&" match-text)
+	(let* ((value-string (match-string 0 match-text))
+	       ;; Strip off value= and trailing &.
+	       (verse-ref-string (substring value-string 6 (1- (length value-string))))
+	       (verse-ref-length (length verse-ref-string))
+	       period)
+
+	  ;; Convert periods
+	  ;; Substitute first period with space
+	  (when (setq period (cl-search "." verse-ref-string))
+	    (aset verse-ref-string period ? ))
+	  ;; Substitute second period with colon
+	  (when (setq period (cl-search "." verse-ref-string))
+	    (aset verse-ref-string period ?:))
+
+	  ;; Handle leading 1, 2 or 3 (i.e. 3 John etc.)
+	  (when (= (aref verse-ref-string 0) ?1)
+	    (setq verse-ref-string (concat "I" (substring verse-ref-string 1))))
+	  (when (= (aref verse-ref-string 0) ?2)
+	    (setq verse-ref-string (concat "II" (substring verse-ref-string 1))))
+	  (when (= (aref verse-ref-string 0) ?3)
+	    (setq verse-ref-string (concat "III" (substring verse-ref-string 1))))
+      
+	  (set-text-properties 0 verse-ref-length nil verse-ref-string) ; Clear unwanted properties (if any)
+	  (insert verse-ref-string))))))
+
+(defun bm--lookup-greek-def (key)
+  "Executes `diatheke' to do query, massages output so verse cross
+references are usable. Returns string. We use HTMLHREF format output
+because it may have verse references as HTML links, depending on the
+lexicon module."
+
   (with-temp-buffer
-    (let ((args (list "diatheke" nil (current-buffer) t "-b" bm-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" lemma)))
+    (let ((args (list "diatheke" nil (current-buffer) t "-b" bm-greek-lexicon "-o" "m" "-f" "HTMLHREF" "-k" key)))
       (apply 'call-process args)
-      ;;;; ;; Clean up outlining in the term buffer. Just fix the first
-      ;;;; ;; level of outline. This is specific to the AbbottSmith module;
-      ;;;; ;; it may help for other versions.
-      ;;;; (format-replace-strings
-      ;;;;  '((" I." . "\n   I.")
-      ;;;; 	 (" 1." . "\n     1.")
-      ;;;; 	 (" (a)" . "\n        (a)")
-      ;;;; 	 (" (α)" . "\n          (α)")
-      ;;;; 	 ("      (i)" . "\n      (i)")
-      ;;;; 	 ("      (1)" . "\n      (1)")
-      ;;;; 	 (". ." . ".")
-      ;;;; 	 (" . " . ". ")))
-      ;;;; (goto-char (point-min))
-      ;;;; (while (search-forward "\n" nil t)
-      ;;;; 	(delete-blank-lines))
-      ;;;;  (goto-char (point-min))
-      ;;;;  ;; Highlight verse references to allow lookup from lexicon
-      ;;;;  ;; entry. XXX This is incomplete and does not handle all the
-      ;;;;  ;; types of cross-reference.
-      ;;;;  (while (search-forward-regexp bm-verse-regexp nil t)
-      ;;;;  (put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
-      ;;;;  (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
-      ;;;;  (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue"))
-      ;;;;  ))
-      (bm--process-href)
+      (bm--process-href)    ; Clean up XML so xrefs can work after rendering.
       (shr-render-region (point-min) (point-max)))
     (buffer-string)))
 
-
 (defun bm--lookup-lex-greek-indexed (key)
+  "If the lexicon module uses Greek lemmas as lookup keys, get the lemmas
+from the Strong's number. Then look up the definition."
   (let ((lemma-entry (bm--lookup-lemma-index key))) ; Get lemma from Strong's number
     (when lemma-entry
       (let ((lemma (caddr (split-string lemma-entry " "))))
-	(bm--lookup-def-by-greek-lemma lemma)))))
+	(bm--lookup-greek-def lemma)))))
 
 
 (defun bm--lookup-lex-greek (key)
-  "Lookup lexical definition using Strong's number. Check hash table first.
-Then, if a lexicon is accessed by lemmas, do lookup using index method;
-otherwise just use the Strong's number method."
+  "Lookup lexical definition using Strong's number as follows:
+1. Check hash table first. If entry found, return.
+2. Otherwise, if a lexicon is accessed by lemmas, do lookup using index method.
+3. Otherwise just use the Strong's number method."
   (or (gethash key greek-hash)
       (puthash key 
 	       (if bm-use-index-for-lexicon
 		   (bm--lookup-lex-greek-indexed key)
-		 (bm--lex-query key bible-mode-greek-lexicon))
+		 (bm--lookup-greek-def key))
 	       greek-hash)))
 
 (defun bm--lookup-strongs-greek (window object pos)
@@ -1003,6 +942,7 @@ lex definition."
       ;; to bypass command substitution in the tooltips.
       (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text)))))
 
+
 (defun bm-handle-divine-name (item)
   (insert "LORD")
   (let* ((refstart (- (point) (length "LORD")))
@@ -1014,12 +954,14 @@ lex definition."
       (put-text-property refstart refend 'help-echo 'bm--show-lex-morph)
       (put-text-property refstart refend 'strong (match-string 0 strongs)))))
 
+
 (defun bm--process-word (item iproperties)
   "Word study. Add tooltips for definitions and morphologyl. 
 Insert lemmas in buffer. Must be done after item is inserted in buffer."
   (let ((word (dom-text item))
 	(morph (dom-attr item 'morph))
 	(savlm (dom-attr item 'savlm))
+	(lemma (dom-attr item 'lemma))
 	(divinename (dom-by-tag item 'divinename)))
 
     (insert word)
@@ -1035,13 +977,14 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
       (when divinename (bm-handle-divine-name item))
 
       ;; lexical definitions
-      (when savlm
-	(let ((matched nil))
-	  (cond ((string-match "strong:G.*" savlm)        ; Greek
-		 (setq matched (match-string 0 savlm))
+      (when (or savlm lemma)
+	(let ((matched nil)
+	      (item (or savlm lemma)))
+	  (cond ((string-match "strong:G.*" item)        ; Greek
+		 (setq matched (match-string 0 item))
 		 (put-text-property refstart refend 'keymap bm-greek-keymap))
-		((string-match "strong:H.*" savlm)        ; Hebrew
-		 (setq matched (match-string 0 savlm))
+		((string-match "strong:H.*" item)        ; Hebrew
+		 (setq matched (match-string 0 item))
 		 (put-text-property refstart refend 'keymap bm-hebrew-keymap)))
 	  ;; Add help-echo, strongs reference for tooltips if match.
 	  (when matched
@@ -1067,6 +1010,8 @@ Insert lemmas in buffer. Must be done after item is inserted in buffer."
 	    (put-text-property refstart refend 'help-echo 'bm--show-lex-morph))))
 
       ;; Insert lemma into buffer. Lemma tag will be part of savlm item.
+      ;; XXX Should I do lexicon lookups on these lemmas? I don't use
+      ;; this anyway....
       (when (and bm-word-study-enabled savlm (string-match "lemma.*:.*" savlm))
 	(dolist (word (split-string (match-string 0 savlm) " "))
 	  (setq word (replace-regexp-in-string "[.:a-zA-Z0-9]+" "" word))
@@ -1328,18 +1273,19 @@ In processing subnodes, each case will prepend a space if it needs it."
 	     (put-text-property refstart refend 'strong (concat "strong:H" matchstr))
 	     (put-text-property refstart refend 'keymap bm-hebrew-keymap)
 	     (add-face-text-property refstart refend `(:foreground "blue")))
-	    ((eq termtype 'greek))
+	    ((eq termtype 'greek)
 	     (put-text-property refstart refend 'strong (concat "strong:G" matchstr))
 	     (put-text-property refstart refend 'keymap bm-greek-keymap)
-	     (add-face-text-property refstart refend `(:foreground "blue")))))
+	     (add-face-text-property refstart refend `(:foreground "blue"))))))
 
   (goto-char (point-min))
+
+  ;; This enables clicking on verse references.
   (while (search-forward-regexp bm-verse-regexp nil t)
     (put-text-property (match-beginning 0) (match-end 0) 'xref (match-string 0))
     (put-text-property (match-beginning 0) (match-end 0) 'keymap bible-search-mode-map)
     (put-text-property (match-beginning 0) (match-end 0) 'help-echo (concat "Go to " (match-string 0)))
     (add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "blue"))
-    (message "Found xref %s" (match-string 0))
     )
   (goto-char (point-min))