Quellcode durchsuchen

Add commentary select; fix xrefs

Fred Gilham vor 2 Wochen
Ursprung
Commit
b6c2144f50
1 geänderte Dateien mit 182 neuen und 96 gelöschten Zeilen
  1. 182 96
      bible.el

+ 182 - 96
bible.el

@@ -3,10 +3,10 @@
 ;; Copyright (c) 2025-2026 Fred Gilham
 
 ;; Author: Fred Gilham <fmgilham@gmail.com>
-;; Version: 1.1.1
+;; Version: 1.2.0
 ;; Keywords: files, text, hypermedia
 ;; Package-Requires: ((emacs "29.1") cl-lib dom shr)
-;; URL: https://gitbot.homedns.org/fred/bible-mode
+;; URL: https://gitbot.homedns.org/fred/bible
 
 ;; This file is not part of GNU Emacs.
 
@@ -206,7 +206,8 @@ See `bible--display-lemma-hebrew'."
 
 (defconst bible--verse-regexp "\\(I \\|1 \\|II \\|2 \\|III \\|3 \\)??[a-zA-Z]+?[ \t\n][0-9]+[:][0-9]+")
 
-(defvar bible--modules (lazy-completion-table bible--modules bible--list-biblical-modules))
+(defvar bible--texts (lazy-completion-table bible--texts bible--list-biblical-texts))
+(defvar bible--commentaries (lazy-completion-table bible--commentaries bible--list-biblical-commentaries))
 
 ;; REVIEW: I believe these chapter counts aren't the same for all modules, e.g. JPS. (FMG 5-Mar-2026)
 (defvar bible--books
@@ -242,25 +243,53 @@ See `bible--display-lemma-hebrew'."
 ;; TODO: Add abbreviations found in other documents/commentaries? (FMG 5-Mar-2026)
 (defvar bible--book-name-abbreviations
   '(;; Old Testament
-    ("Ge"     . "Genesis")         ("Ex"    . "Exodus")           ("Le"   . "Leviticus")     ("Nu"    . "Numbers")
-    ("De"     . "Deuteronomy")     ("Js"    . "Joshua")           ("Jg"   . "Judges")        ("Judg"   . "Judges")
-    ("Ru"    . "Ruth")             ("1 Samuel"     . "I Samuel")  ("I Sa"  . "I Samuel")     ("1 Sa" . "I Samuel")
-    ("2 Samuel"     . "II Samuel") ("II Sa" . "II Samuel")        ("2 Sa" . "II Samuel")     ("1 Kings"  . "I Kings")
-    ("I Ki"  . "I Kings")          ("1 Ki" . "I Kings")           ("2 Kings"      . "II Kings") ("II Ki" . "II Kings")
-    ("2 Ki" . "II Kings")          ("1 Chronicles" . "I Chronicles")  ("I Ch"  . "I Chronicles")  ("1 Ch" . "I Chronicles")
+    ("Ge" . "Genesis") ("Gen" . "Genesis")
+    ("Ex" . "Exodus")
+    ("Le" . "Leviticus")
+    ("Nu" . "Numbers")
+    ("De" . "Deuteronomy") ("Deu" . "Deuteronomy")
+    ("Js" . "Joshua")
+    ("Jg" . "Judges")  ("Judg" . "Judges")
+    ("Ru" . "Ruth")
+    ("1 Samuel" . "I Samuel") ("I Sa" . "I Samuel") ("1 Sa" . "I Samuel")
+    ("2 Samuel" . "II Samuel") ("II Sa" . "II Samuel") ("2 Sa" . "II Samuel")
+    ("1 Kings" . "I Kings") ("I Ki" . "I Kings") ("1 Ki" . "I Kings")
+    ("2 Kings" . "II Kings") ("II Ki" . "II Kings") ("2 Ki" . "II Kings")
+    ("1 Chronicles" . "I Chronicles")  ("I Ch" . "I Chronicles")  ("1 Ch" . "I Chronicles")
     ("2 Chronicles" . "II Chronicles") ("II Ch" . "II Chronicles") ("2 Ch" . "II Chronicles")
-    ("Ezr"  . "Ezra")          ("Ne"    . "Nehemiah")
-    ("Es"     . "Esther")          ("Jb"    . "Job")              ("Ps"   . "Psalms")        ("Pr"    . "Proverbs")
-    ("Ec"     . "Ecclesiastes")    ("So"    . "Song of Solomon")  ("Is"   . "Isaiah")        ("Je"    . "Jeremiah")
-    ("La"     . "Lamentations")    ("Ez"    . "Ezekiel")          ("Da"   . "Daniel")        ("Ho"    . "Hosea")
-    ("Joe"    . "Joel")            ("Am"    . "Amos")             ("Ob"   . "Obadiah")       ("Jon"   . "Jonah")
-    ("Mi"     . "Micah")           ("Na"    . "Nahum")            ("Ha"   . "Habakkuk")      ("Zep"   . "Zephaniah")
-    ("Hag"    . "Haggai")          ("Ze"    . "Zechariah")        ("Mal"  . "Malachi")
+    ("Ezr" . "Ezra")
+    ("Ne" . "Nehemiah")
+    ("Es" . "Esther")
+    ("Jb" . "Job")
+    ("Ps" . "Psalms")
+    ("Pr" . "Proverbs")
+    ("Ec" . "Ecclesiastes")
+    ("So" . "Song of Solomon")
+    ("Is" . "Isaiah")
+    ("Je" . "Jeremiah")
+    ("La" . "Lamentations")
+    ("Ez" . "Ezekiel")
+    ("Da" . "Daniel")
+    ("Ho" . "Hosea")
+    ("Joe" . "Joel")
+    ("Am" . "Amos")
+    ("Ob" . "Obadiah")
+    ("Jon" . "Jonah")
+    ("Mi" . "Micah")
+    ("Na" . "Nahum")
+    ("Ha" . "Habakkuk")
+    ("Zep" . "Zephaniah")
+    ("Hag" . "Haggai")
+    ("Ze"    . "Zechariah")
+    ("Mal"  . "Malachi")
 
     ;; New Testament
     ;; Added AbbottSmith lexicon abbreviations to allow proper following of cross references in lexicon buffers.
     ("Mt" . "Matthew") ("Matt" . "Matthew")
-    ("Mk" . "Mark") ("Lk" . "Luke") ("Jo" . "John") ("Ac" . "Acts")
+    ("Mk" . "Mark")
+    ("Lk" . "Luke")
+    ("Jo" . "John")
+    ("Ac" . "Acts")
     ("Ro" . "Romans") ("Rom" . "Romans")
     ("1 Corintihans" . "I Corinthians") ("I Co" . "I Corinthians") ("1 Co" . "I Corinthians") ("ICor" . "I Corinthians")
     ("2 Corinthians" . "II Corinthians") ("II Co" . "II Corinthians") ("2 Co" . "II Corinthians") ("IICor" . "II Corinthians")
@@ -274,15 +303,15 @@ See `bible--display-lemma-hebrew'."
     ("2 Timothy" . "II Timothy")  ("II Ti" . "II Timothy") ("2 Ti" . "II Timothy") ("IITim" . "II Timothy")
     ("Tit" . "Titus")
     ("Phm" . "Philemon") ("Phlm" . "Philemon")
-    ("He"   . "Hebrews") ("Heb"   . "Hebrews")
-    ("Ja"    . "James") ("Jas"    . "James")
-    ("1 Peter" . "I Peter")   ("I Pe"   . "I Peter")  ("1 Pe" . "I Peter")
-    ("2 Peter" . "II Peter")  ("II Pe"  . "II Peter") ("2 Pe" . "II Peter") ("IIPet" . "II Peter")
-    ("1 John"  . "I John")    ("I Jo"   . "I John")   ("1 Jo" . "I John") ("IJohn" . "I John")
-    ("2 John"  . "II John")   ("II Jo"  . "II John")  ("2 Jo" . "II John")   ("IIJohn" . "II John")
-    ("3 John"  . "III John")  ("III Jo" . "III John") ("3 Jo" . "III John") ("IIIJohn" . "III John")
-    ("Ju"    . "Jude")
-    ("Re"   . "Revelation of John") ("Rev"   . "Revelation of John"))
+    ("He" . "Hebrews") ("Heb" . "Hebrews")
+    ("Ja" . "James") ("Jas" . "James")
+    ("1 Peter" . "I Peter") ("I Pe" . "I Peter") ("1 Pe" . "I Peter")
+    ("2 Peter" . "II Peter")  ("II Pe" . "II Peter") ("2 Pe" . "II Peter") ("IIPet" . "II Peter")
+    ("1 John" . "I John") ("I Jo" . "I John") ("1 Jo" . "I John") ("IJohn" . "I John")
+    ("2 John" . "II John") ("II Jo"  . "II John") ("2 Jo" . "II John") ("IIJohn" . "II John")
+    ("3 John" . "III John") ("III Jo" . "III John") ("3 Jo" . "III John") ("IIIJohn" . "III John")
+    ("Ju" . "Jude")
+    ("Re" . "Revelation of John") ("Rev" . "Revelation of John"))
   "A-list of abbreviations for Bible books.")
 
 ;;;;; Book / chapter
@@ -345,7 +374,8 @@ See `bible--display-lemma-hebrew'."
 
 ;;;;; Misc key bindings
 
-(define-key bible-map "m" 'bible-select-module)
+(define-key bible-map "T" 'bible-select-text)
+(define-key bible-map "C" 'bible-select-commentary)
 (define-key bible-map "w" 'bible-toggle-word-study)
 (define-key bible-map "l" 'bible-toggle-red-letter)
 
@@ -359,39 +389,6 @@ See `bible--display-lemma-hebrew'."
             [menu-bar bible split-display]
             '("Split Display" . bible-split-display))
 
-;;;;; Search
-
-(define-key bible-map "/" 'bible-search)
-(define-key bible-map "s" 'bible-search)
-(define-key bible-map
-            [menu-bar bible search]
-            '("Search" . bible-search))
-
-(define-key bible-map "r" 'bible-set-search-range)
-(define-key bible-map
-            [menu-bar bible range]
-            '("Set Search Range" . bible-set-search-range))
-
-(defconst bible-search-mode-map (make-keymap))
-(define-key bible-search-mode-map "s" 'bible-search)
-(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)
-
-;;;;; Term display
-
-(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-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
 
 (define-key bible-map "p" 'bible-previous-chapter)
@@ -427,6 +424,33 @@ See `bible--display-lemma-hebrew'."
 (define-key bible-map "\C-n" 'next-logical-line)
 (define-key bible-map "\C-p" 'previous-logical-line)
 
+;;;;; Search
+
+(define-key bible-map "/" 'bible-search)
+(define-key bible-map "s" 'bible-search)
+(define-key bible-map
+            [menu-bar bible search]
+            '("Search" . bible-search))
+
+(define-key bible-map "r" 'bible-set-search-range)
+(define-key bible-map
+            [menu-bar bible range]
+            '("Set Search Range" . bible-set-search-range))
+
+(defconst bible-search-mode-map (make-keymap))
+(define-key bible-search-mode-map "s" 'bible-search)
+(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)
+
+;;;;; Term display
+
+(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)
+
+
 (defun bible-toggle-display-diatheke ()
   "Toggle diatheke args display."
   (interactive)
@@ -495,9 +519,13 @@ See `bible--display-lemma-hebrew'."
             [menu-bar bible sepp]
             '(menu-item '"--"))
 
+(define-key bible-map
+            [menu-bar bible select-biblical-commentary]
+            '("Select Commentary" . bible-display-available-commentaries))
+
 (define-key bible-map
             [menu-bar bible select-biblical-text]
-            '("Select Module" . bible-display-available-modules))
+            '("Select Text" . bible-display-available-texts))
 
 ;;;; Terms
 
@@ -561,7 +589,6 @@ This command is run by clicking on text, not directly by the user."
   (visual-line-mode t))
 
 
-
 (define-derived-mode bible-term-mode special-mode "Bible Term"
   "Mode for researching terms in the Bible.
 \\{bible-term-mode-map}"
@@ -571,7 +598,6 @@ 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 bible-term-mode "Bible Term (Hebrew)"
   "Mode for researching Hebrew terms in the Bible.
 \\{bible-term-hebrew-mode-map}")
@@ -580,7 +606,8 @@ This command is run by clicking on text, not directly by the user."
   "Mode for researching Greek terms in the Bible.
 \\{bible-term-greek-mode-map}")
 
-(define-derived-mode bible-module-select-mode special-mode "Select Text Module"
+
+(define-derived-mode bible-module-select-mode special-mode "Select Module"
   (buffer-disable-undo)
   (font-lock-mode t)
   (setq buffer-read-only t))
@@ -673,10 +700,18 @@ specifies the module to use."
         (setq bible-search-range nil)
       (setq bible-search-range range))))
 
-(defun bible-select-module ()
+(defun bible-select-text ()
   "Ask user for a new text module for the current `bible' buffer."
   (interactive)
-  (let ((module (completing-read "Module: " bible--modules)))
+  (let ((module (completing-read "Text: " bible--texts)))
+    (unless (string= module "")
+      (setq-default bible-module module)
+      (bible--display module))))
+
+(defun bible-select-commentary ()
+  "Ask user for a new text module for the current `bible' buffer."
+  (interactive)
+  (let ((module (completing-read "Commentary: " bible--commentaries)))
     (unless (string= module "")
       (setq-default bible-module module)
       (bible--display module))))
@@ -830,17 +865,6 @@ MODULE is the text module to use and defaults to the current module."
       (apply #'call-process args))
     (buffer-string)))
 
-;; TODO: Bible chapter titles mostly appear in Psalms. This code works
-;;       OK except for Psalm 119 which changes the chapter title to
-;;       indicate the Hebrew letter that each verse of a stanza begins
-;;       with.
-;;
-;;       Chapter titles seem to be part of each verse in the modules I saw.
-;;
-;;       Fixing this issue would require keeping track of the current
-;;       chapter title and emitting the title whenever it changed.
-;;       Since there is (AFAIK) only one chapter in the Bible that has
-;;       this issue, it doesn't seem like a high priority now.
 (defvar-local bible-chapter-title nil
   "Text preceding start of chapter.
 Mostly in Psalms, like `Of David' or the like.")
@@ -1303,7 +1327,7 @@ In processing subnodes, each case will prepend a space if it needs it."
                     (let ((end (point)))
 		      (message "crossreferencing %s" (buffer-substring start end))
                       (put-text-property start end 'xref word)
-                      (put-text-property start end 'keymap bible-term-greek-mode-map)
+                      (put-text-property start end 'keymap bible-term-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
@@ -1317,7 +1341,8 @@ In processing subnodes, each case will prepend a space if it needs it."
                     (add-face-text-property (- (point) (length word)) (point) '(:foreground "gray50")))))))))))
 
 (defun bible--display (&optional module verse)
-  "Render a page of Bible text.
+  "Render a page (chapter) of a Bible module.
+Defaults to using `bible-module'.
 If optional argument MODULE is supplied, use that module for display.
 If optional argument VERSE is supplied, set cursor at verse."
   (when module (setq-local bible-module module))
@@ -1389,36 +1414,97 @@ If optional argument VERSE is supplied, set cursor at verse."
     (when verse
       (re-search-forward (concat " ?" (number-to-string verse)) nil t)))
 
-;;;; Modules (Bible texts)
+;;;; Modules (Bible texts, commentaries)
+
+(defun compare-module-names (n1 n2)
+  "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 
+	 (split-string
+	  (bible--exec-diatheke "modulelist" nil "plain" "system")
+	  "[\n\r]+"))
+	(texts nil)
+	(commentaries nil)
+	(doing-texts nil)
+	(doing-commentaries nil))
+    (setq bible--texts nil)
+    (setq bible--commentaries nil)
+    (catch 'done
+      (dolist (line lines)
+	(when doing-texts
+	  (push (split-string line " : ") texts))
+	(when doing-commentaries
+	  (push (split-string line " : ") commentaries))
+	(when (string-equal line "Biblical Texts:")
+	  (setq doing-texts t))
+	(when (string-equal line "Commentaries:")
+	  (setq doing-texts nil)
+	  (pop texts) ; Remove `Commentaries:' line from `bible--texts'.
+	  (setq doing-commentaries t))
+	(when (string-equal line "Lexicons / Dictionaries:")
+	  (pop commentaries) ; Remove `Lexicons / Dictionaries:' line
+			     ; from bible--commentaries.
+	  (throw 'done nil))))
+    (setq bible--texts (sort texts :key #'car :lessp #'compare-module-names))
+    (setq bible--commentaries (sort commentaries :key #'car :lessp #'compare-module-names)))
+  nil)
+
+
+
+(defun bible--list-biblical-texts ()
+  "Return a list of accessible Biblical Text modules."
+  (bible--get-biblical-modules) ; Make sure the lists are fresh.
+  bible--texts)
 
-(defun bible--list-biblical-modules ()
+(defun bible--list-biblical-commentaries ()
   "Return a list of accessible Biblical Text modules."
-  (let ((text (bible--exec-diatheke "modulelist" nil nil "system"))
-        modules)
-    (catch 'done
-      (dolist (line (split-string text "[\n\r]+"))
-        (when (equal line "Commentaries:")
-          (throw 'done nil))
-        (unless (equal "Biblical Texts:" line)
-          (push (split-string line " : ") modules))))
-    (reverse modules)))
+  (bible--get-biblical-modules) ; Make sure the lists are fresh.
+  bible--commentaries)
 
 (defconst bible-module-map (make-keymap))
 (define-key bible-module-map [mouse-1] 'bible-pick-module)
 (define-key bible-module-map (kbd "RET") 'bible-pick-module)
 
 
-(defun bible-display-available-modules ()
+(defun bible-display-available-texts ()
+  "Display available modules, allow user to select."
+  (interactive)
+  (bible--get-biblical-modules) ; Make sure lists are fresh.
+  (with-current-buffer (get-buffer-create "Texts")
+    (bible-module-select-mode)
+    (let ((buffer-read-only nil))
+      (erase-buffer)
+      (setq-local tab-stop-list '(25))
+      (dolist (text bible--texts)
+        (let ((name (string-trim (car text)))
+              (description (string-trim-left (cadr text))))
+          (insert
+           (propertize (string-trim name)
+                       'face 'bold
+                       'module name
+                       'help-echo (concat "Select " name)
+                       'keymap bible-module-map))
+          (move-to-tab-stop)
+          (insert (format "%s\n" description)))))
+    (goto-char (point-min))
+    (pop-to-buffer (current-buffer) nil t)))
+
+(defun bible-display-available-commentaries ()
   "Display available modules, allow user to select."
   (interactive)
-  (with-current-buffer (get-buffer-create "Modules")
+  (bible--get-biblical-modules) ; Make sure lists are fresh.
+  (with-current-buffer (get-buffer-create "Commentaries")
     (bible-module-select-mode)
     (let ((buffer-read-only nil))
       (erase-buffer)
       (setq-local tab-stop-list '(25))
-      (dolist (mod (bible--list-biblical-modules))
-        (let ((name (string-trim (car mod)))
-              (description (string-trim-left (cadr mod))))
+      (dolist (commentary bible--commentaries)
+        (let ((name (string-trim (car commentary)))
+              (description (string-trim-left (cadr commentary))))
           (insert
            (propertize (string-trim name)
                        'face 'bold
@@ -1474,7 +1560,7 @@ If optional argument VERSE is supplied, set cursor at verse."
              "III " "3"
              matchstr))))
          verses)))
-    (sort verses #'string-version-lessp)
+    (sort verses :in-place t :lessp #'string-version-lessp)
     (dolist (verse verses)
       (if query-verses
           (setq query-verses (concat query-verses ";" verse))