Przeglądaj źródła

Get rid of backslashes in tooltip string to avoid command substitution.
Create proper mode for select-modules buffer.

Fred Gilham 8 miesięcy temu
rodzic
commit
0fdf2968c3
1 zmienionych plików z 26 dodań i 26 usunięć
  1. 26 26
      bible-mode.el

+ 26 - 26
bible-mode.el

@@ -1,22 +1,11 @@
 ;;;; -*- mode: EMACS-LISP; lexical-binding: t -*-
-
-;; Copyright (C) 2024  Zacalot
-;; Modifications Copyright (C) Fred Gilham
-
-;; Time-stamp: <2024-05-15 08:37:24 fred>
-
-;; This is distributed in the hope that it will be useful, but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
-;; for more details.
-
-;; See LICENSE file for copying conditions.
-
+;;
 ;; bible-mode.el --- A browsing interface for the SWORD Project's Diatheke CLI
+;; Time-stamp: <2024-05-15 19:11:10 fred>
 
 ;; Author: Zacalot
 ;; Fixes and modifications by Fred Gilham
-;; Url: http://gitbot.homedns.org/fred/bible-mode
+;; Url: https://github.com/fmgilham/bible-mode
 ;; Forked from
 ;; Url: https://github.com/Zacalot/bible-mode
 ;; Version: 1.0.0
@@ -32,7 +21,7 @@
 ;;; Usage:
 
 ;; First install `diatheke'.  On Debian/Ubuntu it's in the `diatheke'
-;; package. In other distributions it might be in a `sword' package.
+;; package. In other distributions it might be in the sword package.
 
 ;; For Windows I found that you can simply install the Xiphos package.
 ;; It includes the Sword library and its utilities including diatheke,
@@ -67,12 +56,6 @@
 ;; with lexical information will display that informatio in a "term"
 ;; buffer.
 
-;; If lexical and morphological tags are available, the mode line will
-;; indicate which are present. In this version no visible tags are
-;; used so that the display is not cluttered by irrelevant details.
-
-;; If word study is enabled and lemmas are present, these will be
-;; displayed.
 
 ;;;
 ;;; bm- is used as shorthand (see Local Variables) for bible-mode-
@@ -85,6 +68,9 @@
 (require 'dom)
 (require 'shr)
 
+;; Turn off tool bar mode because we want the pixels....
+(tool-bar-mode -1)
+
 ;;;; Variables
 
 (defgroup bible-mode nil
@@ -285,7 +271,7 @@
 
 (define-key global-map
 	    [menu-bar bible-mode select-biblical-text]
-	    '("Select Text" . bm-display-available-modules))
+	    '("Select Module" . bm-display-available-modules))
 
 
 
@@ -364,6 +350,12 @@
   (setq buffer-read-only t)
   (visual-line-mode t))
 
+(define-derived-mode module-select-mode special-mode "Select Text Module"
+  (buffer-disable-undo)
+  (font-lock-mode t)
+  (setq buffer-read-only t))
+
+
 ;;;; Functions
 
 ;;;;; Commands
@@ -609,6 +601,11 @@ Note: compiler warns about unused `window' argument."
   (or (gethash query hash)
       (puthash query (bm-morph-query query database) hash)))
 
+(defun substitute-key-definition (olddef newdef keymap)
+  (message "calling me")
+  nil)
+			   
+
 (defun bm-show-lex-morph (window object pos)
   (let* ((lex-morph-text "")
 	 (lex (get-text-property pos 'strong object))
@@ -630,8 +627,9 @@ Note: compiler warns about unused `window' argument."
 	(setq lex-morph-text lex-text))
       (when morph-text
 	(setq lex-morph-text (concat lex-morph-text "\n" morph-text)))
-      ;; This prevents weird substitutions in the tooltip.
-      (propertize lex-morph-text 'help-echo-inhibit-substitution t)
+      ;; This prevents bogus command substitutions in the tooltip by
+      ;; removing backslashes.
+      (setq lex-morph-text (replace-regexp-in-string "\\\\" "" lex-morph-text))
       lex-morph-text)))
 
 
@@ -734,7 +732,7 @@ In processing subnodes, each case will prepend a space if it needs it."
 	     (when verse-start
 	       (let* ((verse-match (string-trim (match-string 0 subnode)))
 		      (verse-start-text (string-trim-left (substring subnode verse-start (length subnode))))
-		      (subnode (concat (substring subnode 0 verse-start) verse-start-text))
+;;		      (subnode (concat (substring subnode 0 verse-start) verse-start-text))
 		      (start (- (point) 1 (length (string-trim-right verse-start-text)))))
 		 (add-face-text-property start (+ start (length (string-trim-right verse-match))) '(:foreground "purple"))))))
 	  ((eq (dom-tag subnode) 'title)
@@ -844,6 +842,7 @@ In processing subnodes, each case will prepend a space if it needs it."
   (let ((buf (get-buffer-create "Modules"))
 	(mods (bm-list-biblical-modules)))
     (set-buffer buf)
+    (module-select-mode)
     (setq buffer-read-only nil)
     (erase-buffer)
     (dolist (mod mods)
@@ -856,7 +855,8 @@ In processing subnodes, each case will prepend a space if it needs it."
        "\t\t"
        (format "%s\n" (cadr mod))))
     (setq buffer-read-only t)
-    (pop-to-buffer buf)))
+    (goto-char (point-min))
+    (pop-to-buffer buf nil t)))