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-14 10:04:32 fred>
+;; Time-stamp: <2024-06-25 09:41:37 fred>
 
 ;; Author: Zacalot
 ;; Fixes and modifications by Fred Gilham
@@ -110,7 +110,7 @@
   "Some lexicons are accessed by lemmas rather than Strong's numbers. Use
 an index to look up lemmas from Strong's numbers so these lexicons can
 be used. Examples of this type of lexicon are AbbottSmith and
-LiddellScott."
+LiddellScott. XXX LiddellScott currently doesn't work."
   :type 'boolean
   :local nil
   :group 'bible-mode)
@@ -166,7 +166,7 @@ which are of the form
 
 ;;(defvar bm-verse-regexp "([\d ]*[a-zA-Z]+( \d*:\d*)?)(( - )| )?(((\d* )?[a-zA-Z]+ )?\d*([:-]+\d*)?)")
 ;; (defvar bm-verse-regexp "/(\d*)\s*([a-z]+)\s*(\d+)(?::(\d+))?(\s*-\s*(\d+)(?:\s*([a-z]+)\s*(\d+))?(?::(\d+))?)?/i")
-(defvar bm-verse-regexp "\\(I?I \\)*[a-zA-Z]* [0-9]*:[0-9]*")
+(defvar bm-verse-regexp "\\(I?I \\)*[a-zA-Z]* [0-9]*[:.][0-9]*")
 
 (defvar bm-modules (lazy-completion-table bm-modules bm--list-biblical-modules))
 
@@ -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,15 +320,26 @@ 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-keymap))
-(defconst bible-term-greek-mode-map (make-keymap))
-;; (defconst bible-term-morph-mode-map (make-keymap))
+(defconst bible-term-hebrew-mode-map (make-sparse-keymap))
+(defconst bible-term-greek-mode-map (make-sparse-keymap))
+
+(define-key bible-term-greek-mode-map [mouse-1] 'bible-search-mode-follow-xref)
 
 ;;;
 ;;; Menu bar items
@@ -345,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 ()
@@ -452,7 +461,7 @@ which are of the form
 \\{bible-term-greek-mode-map}"
   (buffer-disable-undo)
   (font-lock-mode t)
-;;  (use-local-map bible-term-greek-mode-map)
+  (use-local-map bible-term-greek-mode-map)
   (setq buffer-read-only t)
   (visual-line-mode t))
 
@@ -473,7 +482,7 @@ which are of the form
   (let ((buf (get-buffer-create (generate-new-buffer-name (concat "*bible*")))))
     (set-buffer buf)
     (bible-mode)
-    (bm--set-location (assoc (or book-name "Genesis") bm-books) (or chapter 1) verse)
+    (bm--set-location (or (assoc (or book-name "Genesis") bm-books) (list book-name)) (or chapter 1) verse)
     (set-window-buffer (get-buffer-window (current-buffer)) buf)))
 
 ;;;###autoload
@@ -491,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)
-  (field-end))
+  (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)
+  (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))))))
 
 
 
@@ -598,7 +621,8 @@ OT/NT etc."
 	(setq book-abbrev (car verse-ref))
 	(setq chapter-verse (split-string (cadr verse-ref) ":"))))
 
-    (setq book (cdr (assoc book-abbrev bm-book-name-abbreviations-alist)))
+    ;;    (setq book (cdr (assoc book-abbrev bm-book-name-abbreviations-alist)))
+    (setq book (car verse-ref))
     (setq chapter (car chapter-verse)
 	  verse (cadr chapter-verse))
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
@@ -641,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"))))))
@@ -691,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."
@@ -708,58 +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.
+
+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."
+
+  (goto-char (point-min))
+
+  (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."
 
-(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)))
+    (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)    ; 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)
@@ -885,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")))
@@ -896,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)
@@ -917,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
@@ -949,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))
@@ -1194,15 +1257,18 @@ In processing subnodes, each case will prepend a space if it needs it."
 ;;  )
 
 (defun bm--display-term (termtype)
+  (message "bible-mode--display-term %s" termtype)
+
   (setq buffer-read-only nil)
+
   (cl-do* ((text (buffer-string))
 	   (match (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)))
-      ;; This enables clicking on the Strong's numbers inside the term display.
       (cond ((eq termtype 'hebrew)
 	     (put-text-property refstart refend 'strong (concat "strong:H" matchstr))
 	     (put-text-property refstart refend 'keymap bm-hebrew-keymap)
@@ -1211,10 +1277,21 @@ In processing subnodes, each case will prepend a space if it needs it."
 	     (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"))))))
-    
+
   (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"))
+    )
+  (goto-char (point-min))
+
 ;;  (while (search-forward (concat "(" bm-module ")") nil t)
 ;;    (replace-match ""))
+
   (while (search-forward "()" nil t)
     (replace-match ""))
   (goto-char (point-min))
@@ -1265,9 +1342,7 @@ left-to-right. XXX Why doesn't this work for the tooltips?"
 	     (regexp-opt `(,bm-greek-lexicon))
 	     ""
 	     ;;	     (bm--exec-diatheke term nil "plain" nil bm-greek-lexicon)
-	     (bm--lookup-lex-greek term)
-	     nil nil nil 7
-	     ))
+	     (bm--lookup-lex-greek term)))
   (bm--display-term 'greek))