Sfoglia il codice sorgente

Misc fixes and cleanup

Fred Gilham 1 mese fa
parent
commit
e524ccbbc6
1 ha cambiato i file con 102 aggiunte e 83 eliminazioni
  1. 102 83
      bible.el

+ 102 - 83
bible.el

@@ -54,12 +54,33 @@
 
 ;;; Code:
 
+
 ;;;; Requirements
 (require 'dom)
 (require 'shr)
+  
+;;; Fix dom-text and dom-texts obsolescence (check for new function)
+(defalias 'bible-dom-text
+  (if (fboundp 'dom-inner-text)
+      (lambda (node)
+	(dom-inner-text node))
+    (with-no-warnings
+      (lambda (node)
+	(dom-text node)))))
+
+(defalias 'bible-dom-texts
+  (if (fboundp 'dom-inner-text)
+      (lambda (node)
+	(dom-inner-text node))
+    (with-no-warnings
+      (lambda (node)
+	(dom-texts node)))))
 
 ;; Turn off tool bar mode because we are greedy for pixels....
 (tool-bar-mode -1)
+;; eldoc isn't meaningful in this program, and this saves space in the
+;; mode line.
+(global-eldoc-mode -1)
 
 ;;;; Variables
 
@@ -304,6 +325,9 @@ which are of the form
 	    [menu-bar bible display-diatheke]
 	    '("Toggle diatheke display" . bible-toggle-display-diatheke))
 
+(defvar-local bible-debugme nil
+  "Make text show up as XML when set.")
+
 (defun bible-toggle-display-xml ()
   "Toggle XML display."
   (interactive)
@@ -413,8 +437,6 @@ which are of the form
     (setq-local bible-text-direction 'left-to-right))
   (setq-local bidi-paragraph-direction bible-text-direction))
 
-(defvar-local bible-debugme nil
-  "Make text show up as XML when set.")
 
 (defvar-local bible-search-query nil
   "Query used in toggles (word study and red letter).")
@@ -549,7 +571,6 @@ Genesis 1:1 is used."
   (interactive)
   (with-current-buffer (get-buffer-create (generate-new-buffer-name (concat "*bible*")))
     (bible)
-    (eldoc-mode -1) ;; Why is this necessary to avoid eldoc minor mode?
     (bible--set-location
      (or (assoc (or book-name "Genesis") bible--books) (list book-name))
      (or chapter 1)
@@ -671,14 +692,10 @@ Create a new `bible' buffer positioned at the selected verse."
     (message "Following verse result: %s" text)
     (string-match "I?I?I? ?[A-Z]?[a-z]* " text)
     (setq book (match-string 0 text))
-;;    (message "Book: %s" book)
-;;    (message "Following %s" text)
-    (string-match "[0-9]?[0-9]?:" text)
+    (string-match "[0-9]?[0-9]?[0-9]?:" text)
     (setq chapter (substring (match-string 0 text) 0 (1- (length (match-string 0 text)))))
-;;    (message "Chapter: %s" chapter)
     (string-match ":[0-9]?[0-9]?[0-9]?" text)
     (setq verse (substring (match-string 0 text) 1))
-;;    (message "Verse: %s" verse)
     (bible-open (string-trim book) (string-to-number chapter) (string-to-number verse))))
 
 (defun bible-search-mode-follow-xref ()
@@ -701,7 +718,7 @@ Handle abbreviations from lexicon module (AbbottSmith)."
 	  ((= (length verse-ref) 3) ; II Cor 3:17 or the like
 	   (setq book-abbrev (concat (car verse-ref) " " (cadr verse-ref))
 		 chapter-verse (split-string (caddr verse-ref) ":"))))
-    (message "Book abbrev: %s" book-abbrev)
+    ;; Use book abbreviation if present or try whatever is in verse-ref.
     (setq book (or (alist-get book-abbrev bible--book-name-abbreviations nil nil #'string-equal-ignore-case) (car verse-ref))
 	  chapter (car chapter-verse)
 	  verse (cadr chapter-verse))
@@ -1105,7 +1122,7 @@ both tags, otherwise just get lex definition."
 Add tooltips for definitions and morphology. Also insert lemmas in
 buffer if `word study' is turned on (must be done after item is inserted
 in buffer)."
-  (let ((word (string-trim (dom-text item)))
+  (let ((word (string-trim (bible-dom-text item)))
 	(morph (dom-attr item 'morph))
 	(savlm (dom-attr item 'savlm))
 	(lemma (dom-attr item 'lemma))
@@ -1203,10 +1220,15 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	       ('w (insert " ") (bible--process-word subnode iproperties))
 	       ;; Font tag should be ignored, treat as if 'w
 	       ('font (insert " ") (bible--process-word subnode iproperties))
-	       ('i ; Italic face
-		(let ((word (dom-text subnode)))
+	       ('hi (when (equal (dom-attr subnode 'type) "bold")
+		      (let ((word (bible-dom-text subnode)))
+			(insert " " word)
+			(put-text-property (- (point) (length word)) (point) 'face 'bold))))
+	       ('i ; Italic face (special case for certain module)
+		(let ((word (bible-dom-text subnode)))
 		  (insert " " word)
-		  (add-face-text-property (- (point) (length word)) (point) '(:foreground "turquoise"))))
+		  (put-text-property (- (point) (length word)) (point) 'face 'bold)
+		  (add-face-text-property (- (point) (length word)) (point) '(:foreground "orange"))))
 	       ;; '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 notitle))
@@ -1219,29 +1241,30 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 			((equal (dom-attr subnode 'type) "x-indent")
 			 (insert "\t"))
 			((dom-attr subnode 'level)
+;;			 (bible-new-line)
 			 (let ((indent (string-to-number (alist-get 'level attributes))))
 			   (cond ((= indent 1) (insert "\t"))
-				 ((= indent 2) (insert "\n\t"))))))))
+				 ((= indent 2) (insert "\n\t\t"))))))))
 	       ('divinename (bible-handle-divine-name subnode))
 	       ;; Some modules use this for line breaks and such.
 	       ('milestone (when (equal (dom-attr subnode 'type) "line") (bible-new-line)))
 	       ('br (bible-new-line))
 	       ('div (when (equal (dom-attr subnode 'type) "paragraph") (bible-new-line)))
-	       ((or 'scripref 'reference) ;;; XXX Clicking on verse doesn't work yet.
-		(let ((word (dom-text subnode)))
+	       ;; For commentaries and the like. XXX Clicking on verse doesn't work yet. This will take work.
+	       ((or 'scripref 'reference) 
+		(let ((word (bible-dom-text subnode)))
 		  (let ((start (point)))
 		    (insert " " word)
 		    (let ((end (point)))
-		      (message word)
 		      (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)"))
 		      (add-face-text-property start end '(:foreground "blue"))))))
-	       ('b (bible--insert-domnode-recursive subnode iproperties notitle))
-	       ('u (bible--insert-domnode-recursive subnode iproperties notitle))
+	       ;; Various text properties---ignore for now
+	       ((or 'b 'u) (bible--insert-domnode-recursive subnode iproperties notitle))
 	       ;; Word inserted by translation, not in original, give visual indication.
 	       ((or 'transchange 'hi)
-		(let ((word (dom-text subnode)))
+		(let ((word (bible-dom-text subnode)))
 		  (insert " " word)
 		  (if (plist-get iproperties 'jesus)
 		      (add-face-text-property (- (point) (length word)) (point) '(:foreground "salmon"))
@@ -1249,48 +1272,48 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 
 
 (defun bible--display (&optional verse)
-  "Render text for `bible'. If VERSE is supplied, set cursor at verse."
+  "Render a page of text for `bible'. If optional argument VERSE is
+supplied, set cursor at verse."
 
-  ;; Display buffers can have different modules.
   (setq-local bible-module (default-value 'bible-module))
 
-  ;; Clear buffer and insert the result of calling bible--exec-diatheke.
   (let ((buffer-read-only nil)
 	(bible-chapter-title nil)
 	(bible-has-lexemes nil)
 	(bible-has-morphemes nil))
     (erase-buffer)
     (insert (bible--exec-diatheke (concat bible--current-book-name ":" (number-to-string bible--current-chapter))))
+
     ;; Parse the xml in the buffer into a DOM tree.
     (let ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
       ;; Render the DOM tree into the buffer.
-      (unless bible-debugme
+      (unless bible-debugme ; If this is true, display the XML.
 	(erase-buffer)
 	;; Looking for the "body" tag in the DOM node.
 	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
 	(goto-char (point-min))))
+
     (save-excursion
       (let ((search-string (concat (car bible--current-book) " " (number-to-string bible--current-chapter) ":")))
-	;; Delete <Book Ch:> (may be more than one)
+	;; Delete <Book Ch:> at beginning of verse, just leave verse number.
 	(while (search-forward search-string nil t)
-	  (replace-match ""))))
-    (save-excursion
-      ;; Highlight verse number(s)
-      (while (re-search-forward "^ *[0-9]+" nil t)
-	(add-face-text-property (match-beginning 0) (match-end 0) '(:foreground "purple") nil)))
+	  (replace-match "")
+	  ;; Highlight verse number
+	  (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-module ".*$") nil t)
 	(replace-match "" nil t)))
 
-    ;; Deal with chapter titles (i.e. in Psalms)
-    ;; XXX N.B. This won't change a title inside a chapter, and so it
-    ;; doesn't work with Psalm 119 where the acrostic letters get
-    ;; printed as "titles".
     (save-excursion
+      ;; Deal with chapter titles (i.e. in Psalms)
+      ;; XXX N.B. This won't change a title inside a chapter, and so it
+      ;; doesn't work with Psalm 119 where the acrostic letters get
+      ;; printed as "titles".
       (when bible-chapter-title ; This gets set in bible-insert-domnode-recursive.
-	(let ((title-text (dom-texts bible-chapter-title))
+	(let ((title-text (bible-dom-texts bible-chapter-title))
 	      (refstart (point-min))
 	      refend)
 	  (when (stringp title-text)
@@ -1320,14 +1343,14 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
  				("? ”" . "?”")
 				("   " . " ")
 				("  " . " "))
-			      nil (point-min) (point-max)))
+			      nil (point-min) (point-max))))
 
-    ;; Set the mode line of the biffer.
-    (setq mode-name (concat "Bible (" bible--current-book-name " " (number-to-string bible--current-chapter) ") "
-			    bible-module
-			    (when bible-has-lexemes " Lex")
-			    (when bible-has-morphemes " Morph")
-			    ")")))
+  ;; Set the mode line of the biffer.
+  (setq mode-name (concat "Bible (" bible--current-book-name " " (number-to-string bible--current-chapter) ") "
+			  bible-module
+			  (when bible-has-lexemes " Lex")
+			  (when bible-has-morphemes " Morph")
+			  ")"))
 
   ;; If optional verse specification go to that verse.
   (when verse
@@ -1344,7 +1367,7 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
           (throw 'done nil))
 	(when (not (equal "Biblical Texts:" line))
           (push (split-string line " : ") modules))))
-    modules))
+    (reverse modules)))
 
 (defun bible-pick-module ()
   "Keymap action function---select module user chooses."
@@ -1408,45 +1431,41 @@ XXX In processing subnodes, each case will prepend a space if it needs it."
 	(query-verses "")
 	(buffer-read-only nil))
     (erase-buffer)
-    (while match
-      (setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
-	    matchstr (match-string 0 results))
-
-      (when match
-	(push
-	 ;; Massage match to make it more sortable, get rid of some characters.
-	 (replace-regexp-in-string
-	  ".+; " "" 
-	  (string-replace
-	   "I " "1"
-	   (string-replace
-	    "II " "2"
+    (save-excursion
+      (while match
+	(setq match (string-match ".+?:[0-9]?[0-9]?" results (+ match (length matchstr)))
+	      matchstr (match-string 0 results))
+
+	(when match
+	  (push
+	   ;; Massage match to make it more sortable, get rid of some characters.
+	   (replace-regexp-in-string
+	    ".+; " "" 
 	    (string-replace
-	     "III " "3"
-	     matchstr))))
-	 verses)))
-
-    (setq match 0)
-    (setq verses (sort verses :key nil :lessp #'(lambda (s1 s2) (string-version-lessp s1 s2))))
-    (dolist (verse verses)
-      (if query-verses
-	  (setq query-verses (concat query-verses ";" verse))
-	(setq query-verses verse)))
-    (let ((bible-show-diatheke-exec nil))
-      (insert (bible--exec-diatheke query-verses nil nil bible-module))
-
-      (let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
-	(erase-buffer)
-	(bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
-	(goto-char (point-min))
-	(while (re-search-forward (concat "^.*" bible-module ".*$") nil t)
-	  (replace-match "")))
-
-      (setq mode-name (concat "Bible Search (" bible-module))
-      (when bible-search-range
-	(setq mode-name (concat mode-name " [" bible-search-range "]")))
-      (setq mode-name (concat mode-name ")"))
-      (goto-char (point-min)))))
+	     "I " "1"
+	     (string-replace
+	      "II " "2"
+	      (string-replace
+	       "III " "3"
+	       matchstr))))
+	   verses)))
+
+      (setq verses (sort verses :key nil :lessp #'(lambda (s1 s2) (string-version-lessp s1 s2))))
+      (dolist (verse verses)
+	(if query-verses
+	    (setq query-verses (concat query-verses ";" verse))
+	  (setq query-verses verse)))
+      (let ((bible-show-diatheke-exec nil))
+	(insert (bible--exec-diatheke query-verses nil nil bible-module))
+	(let* ((html-dom-tree (libxml-parse-html-region (point-min) (point-max))))
+	  (erase-buffer)
+	  (bible--insert-domnode-recursive (dom-by-tag html-dom-tree 'body) nil nil)
+	  (while (re-search-forward (concat "^.*" bible-module ".*$") nil t)
+	    (replace-match "")))
+	(setq mode-name (concat "Bible Search (" bible-module))
+	(when bible-search-range
+	  (setq mode-name (concat mode-name " [" bible-search-range "]")))
+	(setq mode-name (concat mode-name ")"))))))
 
 ;;;;; Terms (lemmas, morphemes)
 
@@ -1543,8 +1562,8 @@ This code is customized for the BDBGlosses_Strongs lexicon."
 If PREFIX is supplied, prepend PREFIX to the entries.
 Used in tandem with `completing-read' for chapter selection."
   (let ((range-list nil))
-    (dotimes (num (1+ max))
-      (when (>= num min)
+    (dotimes (num (1+ max)) 
+     (when (>= num min)
 	(push (cons (concat prefix (number-to-string num)) num) range-list)))
     (nreverse range-list)))