This repository has been archived by the owner on Feb 11, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 11
/
dtk.el
1999 lines (1826 loc) · 80.4 KB
/
dtk.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; dtk.el --- access SWORD content via diatheke
;;
;; Author: David Thompson
;; Keywords: hypermedia
;; Package-Requires: ((emacs "24.4") (cl-lib "0.6.1") (dash "2.12.0") (seq "1.9") (s "1.9"))
;; Version: 0.2
;; URL: https://github.com/dtk01/dtk.el
;;; Commentary:
;;
;; This package provides access to SWORD content via diatheke, facilitating
;; reading Biblical text or other diatheke-accessible material in Emacs.
;;
;; To browse a particular text in a dedicated buffer, use `dtk'. To insert text
;; directly, use `dtk-bible'.
;;; Code:
;;;; Dependencies
(require 'cl-lib)
(require 'dash)
(require 's)
(require 'seq)
(require 'subr-x)
;;;; Customization
;; User configurable variables:
(defgroup dtk nil
"Read Biblical text and other SWORD resources through diatheke."
:prefix "dtk-"
:group 'convenience)
;;;;; General Settings
(defcustom dtk-program "diatheke"
"Front-end to SWORD library.
Only diatheke is supported at the moment."
:type 'string)
(defcustom dtk-word-wrap t
"Non-nil means to use word-wrapping for continuation lines."
:type 'boolean)
(defcustom dtk-compact-view t
"Show verses in compact view.
If nil, display all verses as if they're retrieved independently, e.g:
John 1:1: In the beginning was the Word, and the Word was with God, and the Word was God.
John 1:2: The same was in the beginning with God.
John 1:3: All things were made by him; and without him was not any thing made that was made.
If non-nil, hide repeated \"chapter\" for all verses except the first one, e.g:
John 1:1 In the beginning was the Word, and the Word was with
God, and the Word was God. 2 The same was in the beginning with
God. 3 All things were made by him; and without him was not any
thing made that was made."
:type 'boolean)
(defcustom dtk-buffer-name "*dtk*"
"Name of buffer for displaying text.")
(defcustom dtk-dict-buffer-name "*dtk-dict*"
"Name of buffer for displaying dictionary entries and references.")
(defcustom dtk-search-buffer-name "*dtk-search*"
"Name of buffer for displaying search results.")
(defvar dtk-diatheke-output-format nil
"Opportunity for user to specify desired the output format when
calling diatheke. Intended to be used in conjunction with
dtk-preserve-diatheke-output-p.")
(defvar dtk-preserve-diatheke-output-p nil
"When true, do not attempt to parse or format, but preserve diatheke
output ``as-is''.")
;;;;; Biblical Text defaults
;; TODO: "module" is a more general term. Rename it properly.
(defcustom dtk-module nil
"Module currently in use.")
(defcustom dtk-module-category nil
"Module category currently in use.")
;;;;; Internal variables
(defcustom dtk--recent-book nil
"Most recently used book when reading user's completion."
;; Normally we read the same book during a short period of time, so save
;; latest input as default. On the contrary, chapter and verses are short
;; numeric input, so we skip them.
)
(defvar dtk-inserter 'dtk-insert-verses
"A function which accepts a single argument, the parsed content. The
current buffer is used. The inserter is only invoked if dtk-parser
is not NIL.")
(defvar dtk-retriever 'dtk-bible-retriever
"A function which accepts a single argument, DESTINATION. Output is
sent to DESTINATION. DESTINATION should be a buffer. The retriever
should honor DTK-DIATHEKE-OUTPUT-FORMAT.")
(defvar dtk-parser 'dtk-bible-parser
"A function which accepts a string, parses it, and returns a list of
plists representing the parsed content.")
(defvar dtk-to-retrieve
(list nil nil)
"A list with two members. Specifies content to be retrieved as
either a single citation or as a pair of citations defining a range
of content.")
;;;;; Constants
(defconst dtk-books
'("Genesis" "Exodus" "Leviticus" "Numbers" "Deuteronomy" "Joshua" "Judges" "Ruth" "I Samuel" "II Samuel" "I Kings" "II Kings" "I Chronicles" "II Chronicles" "Ezra" "Nehemiah" "Esther" "Job" "Psalms" "Proverbs" "Ecclesiastes" "Song of Solomon" "Isaiah" "Jeremiah" "Lamentations" "Ezekiel" "Daniel" "Hosea" "Joel" "Amos" "Obadiah" "Jonah" "Micah" "Nahum" "Habakkuk" "Zephaniah" "Haggai" "Zechariah" "Malachi"
"Matthew" "Mark" "Luke" "John" "Acts" "Romans" "I Corinthians" "II Corinthians" "Galatians" "Ephesians" "Philippians" "Colossians" "I Thessalonians" "II Thessalonians" "I Timothy" "II Timothy" "Titus" "Philemon" "Hebrews" "James" "I Peter" "II Peter" "I John" "II John" "III John" "Jude"
"Revelation of John" ;"Revelations"
)
"List of strings representing books of the Bible.")
(defconst dtk-books-regexp
(regexp-opt dtk-books)
"Regular expression aiming to match a member of DTK-BOOKS.")
;;; Citations
(cl-defstruct dtk-citation
"Specify book, chapter, or verse or some combination thereof."
bk ; a string
ch ; a whole number
vs ; a whole number
)
;;; Functions
;;;###autoload
(defun dtk ()
"If the buffer specified by DTK-BUFFER-NAME already exists, move to it. Otherwise, generate the buffer and then provide a prompt to insert content from the current module into the buffer."
(interactive)
(cond ((dtk-buffer-exists-p)
(switch-to-buffer dtk-buffer-name))
(t
(if (not (dtk-modules-in-category dtk-module-category))
(message "Content is not installed for the selected module category, %s. Install content or change the module category." dtk-module-category)
(dtk-init)
(dtk-go-to)))))
(defun dtk-check-for-text-obesity ()
"Intended for use with handling incoming text from diatheke invocation. If text is of a length likely to trigger a substantial delay due to parsing, confirm the intent of the user. Return a true value if text length is clearly not excessive or if the user has explicitly indicated a desire to process a text of substantial length."
(let ((sane-raw-length 100000))
(or (< (point) sane-raw-length)
dtk-preserve-diatheke-output-p
(if (y-or-n-p "That's a large chunk of text. Are you sure you want to proceed? ")
t
(progn
(message "Okay")
nil)))))
(defun dtk-citation-at-point ()
(make-dtk-citation :bk (get-text-property (point) 'book)
:ch (get-text-property (point) 'chapter)
:vs (get-text-property (point) 'verse)))
(defun dtk-diatheke (query-key module destination &optional diatheke-output-format searchp)
"Invoke diatheke using CALL-PROCESS. Return value undefined. QUERY-KEY is a string or a list (e.g., '(\"John\" \"1:1\")). See the docstring for CALL-PROCESS for a description of DESTINATION. DIATHEKE-OUTPUT-FORMAT is either NIL or a keyword specifying the diatheke output format. Supported keyword values are :osis or :plain."
(let ((call-process-args (list dtk-program
nil
destination
t ; redisplay buffer as output is inserted
;; ARGS
"-b" module)))
(cond (searchp
;; diatheke -b module_name -s regex|multi‐word|phrase [-r search_range] [-l locale] -k search_string
(setf call-process-args (append call-process-args '("-s" "phrase"))))
(diatheke-output-format
(unless (eq diatheke-output-format :kludge)
(setf call-process-args
(append call-process-args
(list
"-o" (cl-case diatheke-output-format
(:osis "nfmslx")
(:plain "n"))
"-f" (cl-case diatheke-output-format
(:osis "OSIS")
(:plain "plain"))))))))
(setq call-process-args (append call-process-args '("-k") (cond ((stringp query-key)
(list query-key))
(t query-key))))
(apply 'call-process call-process-args)))
(defun dtk-diatheke-query-key (a &optional b)
"Return a string usable as a query key for diatheke (for Biblical
book-chapter-verse citations). Two citations, A and B, can be used to
specify a range."
(let ((query-key (dtk-citation-bk a)))
(when (dtk-citation-ch a)
(setq query-key
(cl-concatenate 'string query-key
" "
(number-to-string (dtk-citation-ch a)))))
(when (dtk-citation-vs a)
(setq query-key
(cl-concatenate 'string query-key
":"
(number-to-string (dtk-citation-vs a)))))
(when b
(setq query-key
(cl-concatenate 'string query-key
"-"
(number-to-string (dtk-citation-ch b))))
(when (dtk-citation-vs b)
(setq query-key
(cl-concatenate 'string query-key
":"
(number-to-string (dtk-citation-vs b))))))
query-key))
(defun dtk-diatheke-string (query-key module &optional diatheke-output-format)
"Return a string."
(with-temp-buffer
(dtk-diatheke query-key module t diatheke-output-format)
(buffer-string)))
(defun dtk-dict-raw-lines (key module)
"Perform a dictionary lookup using the dictionary module MODULE with query key KEY (a string). Return a list of lines, each corresponding to a line of output from invocation of diatheke."
;; $ diatheke -b "StrongsGreek" -k 3
(s-lines (dtk-diatheke-string key module)))
(defun dtk-follow ()
"Look for a full citation under point. If point is indeed at a full
citation, navigate to the corresponding text. If point is not at a
full citation, do nothing."
(interactive)
(cl-destructuring-bind (bk ch vs)
(dtk-parse-citation-at-point)
(when (and bk ch)
(dtk-go-to bk ch vs))))
(defun dtk-go-to (&rest retrieve-setup-args
;&optional book chapter verse
)
"Take a cue from the current module, if specified; otherwise query
the user for the desired module. Use the values specified in
DTK-MODULE-MAP to navigate to the desired text."
(interactive)
(let* ((completion-ignore-case t)
(final-module (or (if (or current-prefix-arg ; Called with prefix argument
(not dtk-module))
(completing-read "Module: " (dtk-module-names
dtk-module-category)
nil t nil nil '(nil)))
dtk-module)))
(with-dtk-module final-module
(cond ((dtk-module-available-p dtk-module)
(let ((retrieve-setup (or (dtk-module-map-get dtk-module :retrieve-setup)
(dtk-module-map-get (dtk-module-get-category-for-module dtk-module) :retrieve-setup))))
(if retrieve-setup (apply retrieve-setup retrieve-setup-args)))
(dtk-view-text
t ; clear-buffer-p
t
dtk-module))
(t
(message "Module %s is not available. Use dtk-select-module (bound to '%s' in dtk mode) to select a different module. Available modules include %s"
dtk-module
(key-description (elt (where-is-internal 'dtk-select-module dtk-mode-map) 0))
(dtk-module-names dtk-module-category))
nil)))))
(defmacro with-dtk-module (module &rest body)
"Temporarily consider module MODULE as the default module."
(declare (debug t)
(indent defun))
`(let ((original-module dtk-module))
(dtk-set-module ,module)
,@body
(dtk-set-module original-module)))
(defun dtk-bible (&optional book chapter verse dtk-buffer-p)
"Query diatheke and insert text.
With `C-u' prefix arg, change module temporarily.
Text is inserted in place, unless DTK-BUFFER-P is true.
BOOK is a string. CHAPTER is an integer. VERSE is an integer. If
BOOK is not specified, rely on interacting via the minibuffer to
obtain book, chapter, and verse."
(interactive)
(when (not (dtk-biblical-texts))
(error "One or more Biblical texts must be installed first"))
(let* ((completion-ignore-case t)
(final-module (or (if current-prefix-arg ;; Called with prefix argument
(completing-read "Module: " (dtk-module-names
dtk-module-category)
nil t nil nil '(nil)))
dtk-module))
(final-book (or book
(setq dtk--recent-book
(completing-read "Book: " dtk-books nil nil nil nil dtk--recent-book))))
(final-chapter (or (when chapter (number-to-string chapter))
(read-from-minibuffer "Chapter: ")))
(final-verse (or (when verse (number-to-string verse))
(read-from-minibuffer "Verse: ")))
(chapter-verse (concat final-chapter ":" final-verse)))
;; If dtk-buffer-p is true, insert text in the default dtk buffer
(when dtk-buffer-p
(cond ((not (dtk-buffer-exists-p))
(dtk-init))
(t
(switch-to-buffer dtk-buffer-name))))
;; Expose these values to the retriever
(setf dtk-to-retrieve
(list
(make-dtk-citation :bk final-book
:ch (when (> (length final-chapter) 0)
(string-to-number final-chapter))
:vs (when (> (length final-verse) 0)
(string-to-number final-verse)))
nil))
(with-dtk-module final-module
(dtk-retrieve-parse-insert
(current-buffer)))
))
(defun dtk-bible-parser (raw-string)
"Parse the string RAW-STRING. Return the parsed content as a plist."
(cond ((member dtk-diatheke-output-format '(:kludge :osis :plain))
;; Parsing can trigger an error (most likely XML parsing)
(condition-case nil
(cl-case dtk-diatheke-output-format
(:osis (dtk--parse-osis-xml-lines raw-string))
(:plain (dtk-sto--diatheke-parse-text raw-string))
(:kludge (dtk--parse-osis-xml-lines raw-string))
)
(error
(display-warning 'dtk
(format "dtk failed relying on %s format" dtk-diatheke-output-format)
:warning)
;; Calling function should attempt to degrade gracefully
;; and try simple format if dtk-diatheke-output-format
;; isn't :plain
nil ; return NIL upon parse failure
))
)
(t (error "Value of dtk-diatheke-output-format is problematic"))))
(defun dtk-bible-retriever (destination)
"Insert retrieved content in the buffer specified by DESTINATION."
;; Using :osis as a default is problematic since invoking `-f OSIS`
;; with diatheke yields output that has a variety of issues - e.g.,
;; see http://tracker.crosswire.org/browse/MODTOOLS-105.
(unless dtk-diatheke-output-format
(setq dtk-diatheke-output-format :kludge))
(with-current-buffer destination
(insert
(with-temp-buffer
(dtk-diatheke
(dtk-diatheke-query-key (cl-first dtk-to-retrieve)
(cl-second dtk-to-retrieve))
dtk-module
t
dtk-diatheke-output-format
nil)
(if (dtk-check-for-text-obesity)
(progn
(unless dtk-preserve-diatheke-output-p
(dtk-bible-retriever--post-process))
(buffer-string))
" " ; avoid triggering zero length warning
)))))
(defun dtk-bible-retriever--post-process ()
"Post-processing directly after insertion of text supplied via
diatheke."
;; Removes diatheke's quirky addition of parenthesized indications of the module name after the requested text.
(let ((end-point (point)))
(re-search-backward "^(.*)" nil t 1)
(delete-region (point) end-point))
;; Search back and remove duplicate text of last verse and the preceding colon
(let ((end-point (point)))
(re-search-backward "^:" nil t 1)
(delete-region (point) end-point)))
(defun dtk-bible-retrieve-setup (&optional book chapter verse dtk-buffer-p)
"BOOK is a string. CHAPTER is an integer. VERSE is an integer. If
BOOK is not specified, rely on interacting via the minibuffer to
obtain book, chapter, and verse. Set DTK-TO-RETRIEVE."
(interactive)
(let* ((completion-ignore-case t)
(final-book (or book
(setq dtk--recent-book
(completing-read "Book: " dtk-books nil nil nil nil dtk--recent-book))))
(final-chapter (or (when chapter (number-to-string chapter))
(read-from-minibuffer "Chapter: ")))
(final-verse (or (when verse (number-to-string verse))
(read-from-minibuffer "Verse: ")))
(chapter-verse (concat final-chapter ":" final-verse)))
;; Support verse ranges (e.g., FINAL-VERSE values like "1-2")
(let ((maybe-verse-range (if (> (length final-verse) 0)
(split-string final-verse "-")
nil)))
;; Expose these values to the retriever
(setf (elt dtk-to-retrieve 0)
(make-dtk-citation :bk final-book
:ch (when (> (length final-chapter) 0)
(string-to-number final-chapter))
:vs (when maybe-verse-range
(string-to-number (elt maybe-verse-range 0)))))
(setf (elt dtk-to-retrieve 1)
(if (elt maybe-verse-range 1)
(make-dtk-citation :bk final-book
:ch (when (> (length final-chapter) 0)
(string-to-number final-chapter))
:vs (string-to-number (elt maybe-verse-range 1)))
nil)))))
(defun dtk-retrieve-parse-insert (insert-into)
"Invoke DTK-RETRIEVER, anticipating that the text of interest will
be inserted into the buffer specified by INSERT-INTO. If
DTK-PRESERVE-DIATHEKE-OUTPUT-P is true, preserve the retrieved text.
If DTK-PRESERVE-DIATHEKE-OUTPUT-P is NIL, parse the retrieved text
using DTK-PARSER. Once parsed, invoke DTK-INSERTER with the value
returned by DTK-PARSER (presumably the parse representation of the
text), replacing the originally-inserted text with that generated by
DTK-INSERTER."
(let ((point-start (point)))
(cond (dtk-retriever
(funcall dtk-retriever insert-into))
(t
(display-warning
'dtk
(message "retriever not defined for the %s module" dtk-module)
:warning)))
(let ((point-end (point)))
(when (and dtk-parser (not dtk-preserve-diatheke-output-p))
(let ((raw-content (buffer-substring-no-properties point-start
point-end)))
;; sanity check(s) for raw-content
;; - e.g., if it is "", something has gone awry
(cond ((and (stringp raw-content) (> (length raw-content) 0))
(let ((parsed-content (funcall dtk-parser raw-content)))
(cond (parsed-content
(cond (dtk-inserter
(kill-region point-start point-end)
(funcall dtk-inserter parsed-content))
(t
(display-warning
'dtk
(message "inserter not defined for the %s module" dtk-module)
:warning))))
(t
(display-warning
'dtk
"Parsing yielded nothing. Is this expected behavior?"
:warning
)
))))
(t
(error "Something went awry"))))))))
;;;###autoload
(defun dtk-search (&optional word-or-phrase)
"Search for the text string WORD-OR-PHRASE. If WORD-OR-PHRASE is NIL, prompt the user for the search string."
(interactive)
(let ((word-or-phrase (or word-or-phrase (read-from-minibuffer "Search: ")))
(search-buffer (dtk-ensure-search-buffer-exists)))
(dtk-clear-search-buffer)
(dtk-switch-to-search-buffer)
(dtk-search-mode)
(dtk-diatheke word-or-phrase dtk-module t nil t)
))
(defun dtk-search-follow ()
"Populate the dtk buffer with the text corresponding to the citation at point."
(interactive)
;; The most likely desired behavior is to open the dtk buffer
;; alongside the dtk-search buffer and to keep the focus in
;; dtk-search buffer
(dtk-clear-dtk-buffer)
(dtk-follow)
(switch-to-buffer-other-window dtk-search-buffer-name)
)
;;;
;;; dtk modules/books
;;;
(defun dtk-bible-module-available-p (module)
"Indicate whether the module MODULE is available. MODULE is a string."
(dtk-module-available-p module "Biblical Texts"))
(defun dtk-biblical-texts ()
"Return a list of module names associated with the 'Biblical Texts' category."
(dtk-modules-in-category "Biblical Texts"))
(defun dtk-commentary-module-available-p (module)
"Return an indication of whether module MODULE is both available and associated with the 'Commentaries' category."
(dtk-module-available-p module "Commentaries"))
(defun dtk-module-available-p (module-name &optional module-category)
"Test whether the module specified by MODULE-NAME is locally available. MODULE-CATEGORY is either NIL or a string such as 'Biblical Texts' or 'Commentaries'. If NIL, test across all modules (don't limit by module category)."
(member module-name (dtk-module-names (or module-category :all))))
(defun dtk-module-category (category)
"CATEGORY is a string such as 'Biblical Texts' or 'Commentaries'."
(assoc category (dtk-modulelist)))
(defun dtk-module-get-category-for-module (module)
(cl-loop
for modulelist-entry in (dtk-modulelist)
if (member module (dtk-module-names-from-modulelist-entry modulelist-entry))
do (cl-return (cl-first modulelist-entry))))
(defvar dtk-module-last-selection nil
"A plist specifying the last selection of a module by module category.")
(defvar dtk-module-map
'(
;; key: string for module or module category
("Biblical Texts" :retriever dtk-bible-retriever
:parser dtk-bible-parser
:inserter dtk-insert-verses
:retrieve-setup dtk-bible-retrieve-setup)
;("Daily" dtk-daily-retrieve dtk-daily-parse dtk-daily-insert)
("StrongsGreek" :parser dtk-dict-strongs-parse)
("StrongsHebrew" :parser dtk-dict-strongs-parse)
)
"DTK-MODULE-MAP is an alist where each key is a string corresponding
either to a module category or a module. Modules and module categories
are specified with string suchs as 'KJV', 'ESV2011', 'Biblical Texts',
or 'Commentaries'. Each entry maps a module or module category to a
key-value store which specifies a retriever, a parser, an inserter,
and/or a mode. The mode, if specified, is specified by the
corresponding symbol. :RETRIEVE-SETUP, if specified, specifies a
funcallable entity to invoke prior to retrieving the text."
)
(defun dtk-module-map-entry (module-name)
"Return the member of DTK-MODULE-MAP describing the module specified by MODULE-NAME."
(assoc module-name dtk-module-map))
(defun dtk-module-map-get (module-spec key)
"Return the specified value, if any, associated with the module specified by MODULE-SPEC."
(plist-get (cl-rest (dtk-module-map-entry module-spec))
key))
(defun dtk-module-map-get-mode (module-spec)
"Return the mode specification, if any, associated with the module or module category specified by MODULE-SPEC."
(let ((mode (dtk-module-map-get module-spec :mode)))
(cond ((not mode)
;; Fall back to module category if mode is not specified
;; for a specific module
(if (dtk-module-get-category-for-module module-spec)
(setq mode
(dtk-module-map-get-mode
(dtk-module-get-category-for-module module-spec)))))
;; The mode should be specified as a symbol
((symbolp mode)
mode)
(mode
(error "%s" "The corresponding mode must be specified as a symbol.")))))
(defun dtk-module-names (module-category)
"Return a list of strings, each corresponding to a module name within the module category specified by MODULE-CATEGORY. If MODULE-CATEGORY is :all, return all module names across all categories."
(cond ((eq module-category :all)
(let ((shortnames nil))
(mapc #'(lambda (category-data)
(mapc #'(lambda (shortname-description)
(push (elt shortname-description 0) shortnames))
(cdr category-data)))
(dtk-modulelist))
shortnames))
((stringp module-category)
(mapcar #'(lambda (shortname-description)
(elt shortname-description 0))
(cdr (assoc (or module-category dtk-module-category)
(dtk-modulelist)))))))
(defun dtk-module-remember-selection (module-category module)
"Remember the module last selected by the user in the module category MODULE-CATEGORY."
(setq dtk-module-last-selection (lax-plist-put dtk-module-last-selection
module-category
module)))
(defun dtk-modulelist ()
"Return an alist where each key is a string corresponding to a category and each value is a list of lists. Each value represents a set of modules. Each module is described by a list of the form (\"Nave\" \"Nave's Topical Bible\")."
(let ((modulelist-strings (s-lines (dtk-diatheke-string '("modulelist") "system")))
(modules-by-category nil))
;; construct list with the form ((category1 module11 ...) ... (categoryN moduleN1 ...))
(dolist (x modulelist-strings)
(cond ((string= "" (s-trim x)) ; disregard empty lines
nil)
;; if last character in string is colon (:), assume X represents a category
((= (aref x (1- (length x)))
58)
(push (list (seq-subseq x 0 (1- (length x)))) modules-by-category))
(t
;; handle "modulename : moduledescription"
(let ((colon-position (seq-position x 58)))
;; Lack of a colon suggests something is awry
(cond (colon-position
(let ((modulename (seq-subseq x 0 (1- colon-position)))
(module-description (seq-subseq x (+ 2 colon-position))))
(setf (elt modules-by-category 0)
(append (elt modules-by-category 0)
(list (list modulename module-description))))))
(t (display-warning 'dtk
"Inspect the value returned by (dtk-diatheke-string '(\"modulelist\") \"system\")"
:warning)))
))))
modules-by-category))
(defun dtk-modules-in-category (category)
"Return a list of module names associated with module category CATEGORY."
(dtk-module-names-from-modulelist-entry (dtk-module-category category)))
(defun dtk-module-names-from-modulelist-entry (modulelist-entry)
"Return a list of module names. MODULELIST-ENTRY has the form of a
member of the value returned by DTK-MODULELIST."
(let ((module-descriptions (cdr modulelist-entry)))
(mapcar
#'(lambda (modulename-description)
(elt modulename-description 0))
module-descriptions)))
;;;###autoload
(defun dtk-select-module-category ()
"Prompt the user to select a module category."
(interactive)
(let ((module-category
(let ((completion-ignore-case t))
(completing-read "Module type: "
(dtk-modulelist)))))
(if (and module-category
(not (string= module-category "")))
(setf dtk-module-category module-category))))
;;;###autoload
(defun dtk-select-module (&optional prompt)
"Prompt the user to select a module. Return the selected module value."
(interactive)
(let ((module (dtk-select-module-of-type (or prompt "Module: ")
dtk-module-category)))
(if module
(progn
(dtk-set-module module)
(dtk-module-remember-selection dtk-module-category module)
module)
(message "Module not selected"))))
(defun dtk-select-module-of-type (prompt module-category)
"Prompt the user to select a module. MODULE-CATEGORY specifies the subset of modules to offer for selection."
(let ((completion-ignore-case t))
(completing-read prompt
(dtk-module-names module-category)
nil
t
nil
nil
'(nil))))
(defun dtk-set-module (module)
(setq dtk-module module)
;; Set retriever, parser, inserter values
(cond ((dtk-module-map-entry module)
(setq dtk-parser (dtk-module-map-get module :parser))
(setq dtk-retriever (dtk-module-map-get module :retriever))
(setq dtk-inserter (dtk-module-map-get module :inserter)))
;; Use category entry as fallback if an entry isn't present for a specific module
((dtk-module-map-entry (dtk-module-get-category-for-module module))
(let ((category (dtk-module-get-category-for-module module)))
(setq dtk-parser (dtk-module-map-get category :parser))
(setq dtk-retriever (dtk-module-map-get category :retriever))
(setq dtk-inserter (dtk-module-map-get category :inserter))))
(t (message "Specify parser, retriever, and inserter for the module"))
))
;;;
;;; dtk buffers
;;;
(defun dtk-buffer-exists-p ()
"Return an indication of whether the default dtk buffer exists."
(get-buffer dtk-buffer-name))
(defun dtk-clear-buffer (buffer-name)
(with-current-buffer buffer-name
(delete-region (point-min) (point-max))))
(defun dtk-clear-dtk-buffer ()
"Clear the dtk buffer."
(interactive)
(dtk-clear-buffer dtk-buffer-name))
(defun dtk-clear-search-buffer ()
"Clear the search buffer."
(dtk-clear-buffer dtk-search-buffer-name))
(defun dtk-init ()
"Initialize dtk buffer, if necessary. Switch to the dtk buffer."
(when (not (dtk-buffer-exists-p))
(get-buffer-create dtk-buffer-name))
;; Switch window only when we're not already in *dtk*
(if (not (string= (buffer-name) dtk-buffer-name))
(switch-to-buffer-other-window dtk-buffer-name)
(switch-to-buffer dtk-buffer-name))
(dtk-mode)
)
(defun dtk-ensure-search-buffer-exists ()
"Ensure the default dtk buffer exists for conducting a search."
(get-buffer-create dtk-search-buffer-name))
(defun dtk-set-mode ()
"If a mode is specified for the current module, set it for the
current buffer. Fall back to the module category if a mode is not
specified for a specific module."
(let ((mode (dtk-module-map-get-mode dtk-module)))
(when mode
(funcall mode))))
(defun dtk-switch-to-search-buffer ()
"Switch to the dtk search buffer using SWITCH-TO-BUFFER."
(switch-to-buffer dtk-search-buffer-name))
;;;
;;; interact with dtk buffers
;;;
(defun dtk-verse-inserter (book ch verse text new-bk-p new-ch-p)
"Insert a verse associated book BOOK, chapter CH, verse number
VERSE, and text TEXT. If invoked in the context of a change to a new
book or a new chapter, indicate this with NEW-BK-P or NEW-CH-P,
respectively."
(dtk-maybe-insert-book-chapter book ch new-bk-p new-ch-p)
(when verse
(let ((verse-start (point)))
(when dtk-verse-number-inserter
(funcall dtk-verse-number-inserter (int-to-string verse)))
(set-text-properties verse-start (point) (list 'book book 'chapter chapter 'verse verse))
;; fontify verse numbers explicitly
(add-text-properties verse-start (point) '(font-lock-face dtk-verse-number))))
(when text
(let ((text-start (point)))
(funcall dtk-verse-text-inserter text)
;; verse text inserter may set text properties
(add-text-properties text-start (point) (list 'book book 'chapter chapter 'verse verse))))
(unless dtk-compact-view
(insert #xa)))
(defvar dtk-verse-number-inserter
(lambda (verse-number)
(insert verse-number #x20)))
(defun dtk-text-props-for-lemma (lemma)
"Return text properties for LEMMA."
(let ((strongs-refs (dtk-dict-parse-osis-xml-lemma lemma))
(text-props nil))
(unless strongs-refs
(warn "Failed to handle lemma value %s" lemma))
(cl-map nil #'(lambda (strongs-ref)
;; ignore lemma components which were disregarded by DTK-DICT-PARSE-OSIS-XML-LEMMA
(when strongs-ref
(cl-destructuring-bind (strongs-number module)
strongs-ref
(when dtk-show-dict-numbers (insert " " strongs-number))
(setq text-props
(append
(list 'dict (list strongs-number module))
text-props)))))
strongs-refs)
text-props))
(defun dtk-insert-osis-string (string)
;; Ensure some form of whitespace precedes a word. STRING may be a word, a set of words (e.g., "And" or "the longsuffering"), or a bundle of punctuation and whitespace (e.g., "; ").
(when (string-match "^[a-zA-Z]" string)
(when (not (member (char-before) '(32 9 10 11 12 13 8220)))
(insert #x20)))
(insert string)
;; Ensure whitespace succeeds certain characters.
(when (member (char-before) '(58))
(insert #x20)))
(defun dtk-insert-osis-elt (osis-elt)
(let* ((tag (pop osis-elt))
(attributes (pop osis-elt))
(children osis-elt))
(cl-case tag
(w
(when children
;; The example provided in the 2006 description of OSIS shows
;; the "gloss" attribute used to support inclusion of
;; Strong's numbers. The reality seems to be that the "lemma"
;; attribute is used to support inclusion of Strong's numbers
;; for Biblical texts. The whole thing is pretty tenuous
;; since the devs make it clear these attributes are not to
;; be relied upon. The latest-greatest attribute appears to
;; be "savlm".
(let ((lemma (let ((lemma-pair (or (assoc 'lemma attributes)
(assoc 'savlm attributes))))
(if lemma-pair
(cdr lemma-pair)))))
(let ((beg (point)))
(dtk-simple-osis-inserter children)
(when lemma
(add-text-properties beg (point)
(dtk-text-props-for-lemma lemma))
)))))
(divineName
(dtk-simple-osis-inserter children))
(transChange
(when children
(let ((beg (point)))
(dtk-simple-osis-inserter children)
;;(add-text-properties beg (point) (list 'transChange t))
;;(add-text-properties beg (point) '(font-lock-face dtk-translChange-face))
)))
(q ; quote
(let ((quote-marker (let ((quote-marker-pair (assoc 'marker attributes)))
(if quote-marker-pair
(cdr quote-marker-pair)))))
(when quote-marker (insert quote-marker))
(dtk-simple-osis-inserter children)
))
;; containers
(div
(let ((type (let ((type-pair (assoc 'type attributes)))
(if type-pair
(cdr type-pair)))))
(cond ((and
t ;dtk-honor-osis-div-paragraph-p
(cl-equalp type "paragraph"))
(insert #xa)))
(dtk-simple-osis-inserter children)))
(chapter
(dtk-simple-osis-inserter children))
(verse
(dtk-simple-osis-inserter children))
(l ; poetic line(s)
(dtk-simple-osis-inserter children))
(lg ; poetic line(s)
(dtk-simple-osis-inserter children))
(note
(when nil ;dtk-show-notes-p
(dtk-simple-osis-inserter children)))
;; formatting
(milestone
(let ((type (let ((type-pair (assoc 'type attributes)))
(if type-pair
(cdr type-pair)))))
(cond ((and nil ;dtk-honor-osis-milestone-line-p
(cl-equalp type "line"))
(insert #xa)))))
(lb
(when (and t ;dtk-honor-osis-lb-p
(insert #xa))))
;; indicate inability to handle this OSIS element
(t (when nil ;dtk-flag-unhandled-osis-elements-p
(insert "!" (prin1-to-string tag) "!"))))))
(defun dtk-insert-osis-thing (osis-thing)
"Insert verse text represented by OSIS-THING."
(cond ((stringp osis-thing)
(dtk-insert-osis-string osis-thing))
((consp osis-thing)
(dtk-insert-osis-elt osis-thing))
;; indicate inability to handle this elt
(t (insert "*" (prin1-to-string osis-thing) "*"))))
(defvar dtk-verse-text-inserter
'dtk-simple-osis-inserter
"Specifies function used to insert verse text.
The function is called with a single argument, CHILDREN, a list where
each member is either a string or a list representing a child element
permissible within an OSIS XML document. Consider this example
representation of a W element:
(w ((lemma . \"strong:G1722\") (wn . \"001\")) \"In\")")
(defun dtk-simple-osis-inserter (children)
(dolist (osis-elt children)
(dtk-insert-osis-thing osis-elt)))
(defun dtk-insert-verses (verse-plists)
"Insert formatted text described by VERSE-PLISTS."
(cl-flet ()
(let ((this-chapter nil)
(first-verse-plist (pop verse-plists)))
;; handle first verse
(-let (((&plist :book book :chapter chapter :title title :verse verse :text text) first-verse-plist))
(if title (dtk-insert-title title))
(when dtk-insert-verses-pre
(funcall dtk-insert-verses-pre book chapter verse verse-plists))
(dtk-verse-inserter book chapter verse text t t)
(setf this-chapter chapter))
;; Format the remaining verses, anticipating changes in chapter
;; number. Assume that book will not change.
(cl-loop
for verse-plist in verse-plists
do (-let (((&plist :book book :chapter chapter :title title :verse verse :text text) verse-plist))
(if (equal chapter this-chapter)
(progn
(unless (member (char-before) '(#x20 #x0a #x0d))
(insert #x20)
(add-text-properties (1- (point))
(point)
(list 'book book
'chapter chapter)))
(dtk-verse-inserter book chapter verse text nil nil))
;; new chapter
(progn
(insert #xa #xa)
(setf this-chapter chapter)
(dtk-verse-inserter book chapter verse text nil t)))))
(when dtk-insert-verses-post (funcall dtk-insert-verses-post))
)))
(defun dtk-insert-title (title)
(let ((title-start (point)))
(insert (plist-get title :text) ?\n)
(add-text-properties title-start (point)
'(font-lock-face dtk-chapter-title))))
(defvar dtk-insert-verses-pre nil
"If non-NIL, this should define a function to invoke prior to
inserting a set of verses via DTK-INSERT-VERSES. The function is
called with four arguments: book, chapter, verse, and verse-plists.")
(defvar dtk-insert-verses-post nil
"If non-NIL, this should define a function to invoked after
insertion of a set of verses via DTK-INSERT-VERSES.")
(defun dtk-maybe-insert-book-chapter (book chapter new-bk-p new-ch-p)
"If the context is appropriate, insert book and/or chapter."
(let ((book-start (point)))
(when (or (not dtk-compact-view) new-bk-p)
(insert book #x20)
(set-text-properties book-start (point) (list 'book book))))
(when (or (not dtk-compact-view) new-ch-p)
(let ((chapter-start (point)))
(insert (int-to-string chapter)
(if verse #x3a #x20))
(add-text-properties (if new-ch-p
chapter-start
book-start)
(point)
(list 'book book 'chapter chapter 'font-lock-face 'dtk-chapter-number)))))
(defun dtk-parse-citation-at-point ()
(if (dtk-to-start-of-full-citation)
(dtk-parse-citation-starting-at-point)
'(nil nil nil)))
(defun dtk-parse-citation-starting-at-point ()
"Assume point is at the start of a full verse citation. Return a list where the first member specifies the book, the second member specifies the chapter, and the third member specifies the verse by number."
(let ((book-start-position (point))
(book-end-position nil)
(chapter-start-position nil)
(colon1-position nil)
;; CITATION-END-POSITION: last position in the full citation
(citation-end-position nil))
;; move to start of chapter component of citation
(search-forward ":")
(setf colon1-position (point))
(search-backward " ")
(setf book-end-position (1- (point)))
(forward-char)
(setf chapter-start-position (point))
;; move to end of of citation
(search-forward ":")
;; - if citation is end start of buffer, searching for non-word character will fail
(condition-case nil
(progn (search-forward-regexp "\\W")
(backward-char))
(error nil
(progn (goto-char (point-max))
(backward-char)
(message "end-of-buffer"))))
(setf citation-end-position (point))
(list
(buffer-substring-no-properties book-start-position (1+ book-end-position))
(string-to-number (buffer-substring-no-properties chapter-start-position (1- colon1-position)))
(string-to-number
(buffer-substring-no-properties colon1-position citation-end-position)))))
(defun dtk-preview-citation ()
"Preview citation at point."
(interactive)
;; lazy man's preview -- append at end of *dtk* buffer so at least it's readable
(with-current-buffer dtk-buffer-name
;; (move-point-to-end-of-dtk-buffer)
(goto-char (point-max))
;; (add-vertical-line-at-end-of-dtk-buffer)
(insert #xa))
;; (back-to-point-in-search/current-buffer)
(dtk-follow))
(defun dtk-quit ()
"Quit."
(interactive)
(when (member (buffer-name (current-buffer))
(list dtk-buffer-name dtk-dict-buffer-name dtk-search-buffer-name))
(kill-buffer nil)))