-
Notifications
You must be signed in to change notification settings - Fork 2
/
fb2-reader.el
2000 lines (1735 loc) · 69.6 KB
/
fb2-reader.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
;;; fb2-reader.el --- Read FB2 and FB2.ZIP documents -*- lexical-binding: t; -*-
;; 184
;; Copyright (c) 2021 Dmitriy Pshonko <[email protected]>
;; Author: Dmitriy Pshonko <[email protected]>
;; URL: https://github.com/jumper047/fb2-reader
;; Keywords: multimedia, ebook, fb2
;; Version: 0.1.1
;; Package-Requires: ((emacs "26.2") (f "0.17") (s "1.11.0") (dash "2.12.0") (visual-fill-column "2.2") (async "1.9.4"))
;; This file is NOT part of GNU Emacs.
;;; License:
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program 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.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; fb2-reader.el provides a major mode for reading FB2 books.
;;
;; Features:
;;
;; - read .fb2 and .fb2.zip files
;; - rich book formatting
;; - showing current title in header line
;; - internal links (select from keyboard, jumb back and forth)
;; - navigation (next/previous chapters, imenu support)
;; - restoring last read position
;; - displaying raw xml
;; - book info screen
;; - table of content in separate buffer
;;
;; Coming soon:
;;
;; - integration with https://github.com/jumper047/librera-sync
;; - rendering book in org-mode
;;
;; Installation:
;; Add these strings to your config:
;;
;; (use-package fb2-reader
;; :commands (fb2-reader-continue)
;; :custom
;; ;; This mode renders book with fixed width, adjust to your preferences.
;; (fb2-reader-page-width 120)
;; (fb2-reader-image-max-width 400)
;; (fb2-reader-image-max-height 400))
;;
;; Usage:
;; Just open any fb2 book, or execute command =fb2-reader-continue=
;;; Code:
(require 'visual-fill-column)
(require 'subr-x)
(require 'cl-lib)
(require 'imenu)
(require 'dash)
(require 'f)
(require 's)
(require 'async)
(defcustom fb2-reader-settings-dir (expand-file-name "fb2-reader" user-emacs-directory)
"Path to directory with saved places etc."
:type 'directory
:group 'fb2-reader)
(defcustom fb2-reader-cache-dir (expand-file-name "fb2-reader" user-emacs-directory)
"Path to directory with cached books."
:type 'directory
:group 'fb2-reader)
(defcustom fb2-reader-title-in-headerline t
"Show current chapter's title in headerline."
:type 'boolean
:group 'fb2-reader)
(defcustom fb2-reader-hide-cursor t
"Enable `fb2-reader-no-cursor-mode' at mode's start."
:type 'boolean
:group 'fb2-reader)
(defcustom fb2-reader-restore-position t
"Restore last viewed position on book's opening."
:type 'boolean
:group 'fb2-reader)
(defcustom fb2-reader-hide-nobreak t
"Hide nobreak character in fb2-reader buffer."
:type 'boolean
:group 'fb2-reader)
(defcustom fb2-reader-page-width 120
"Width of the rendered text."
:type 'integer
:group 'fb2-reader)
(defcustom fb2-reader-show-images 't
"Show images."
:type 'boolean
:group 'fb2-reader)
(defcustom fb2-reader-image-max-width 400
"Maximum width of the displayed image."
:type 'integer
:group 'fb2-reader)
(defcustom fb2-reader-image-max-height 400
"Maximum height of the displayed image."
:type 'integer
:group 'fb2-reader)
(defcustom fb2-reader-max-in-cache 20
"Maximum number of files stored in cache."
:type 'integer
:group 'fb2-reader)
(defcustom fb2-reader-toc-indent 2
"Indentation for each level in outline buffer."
:type 'integer
:group 'fb2-reader)
(defcustom fb2-reader-splash-text nil
"Custom text on loading splash screen.
If nil \"Loading, please wait\" translated to book's language
will be used. Enter your variant if you need something special."
:type 'string
:group 'fb2-reader)
(defface fb2-reader-splash
'((t (:height 1.5 :inherit default)))
"Face for splash screen text about book rendering"
:group 'fb2-reader)
(defface fb2-reader-info-field
'((t (:weight bold)))
"Face for field name in book info buffer."
:group 'fb2-reader)
(defface fb2-reader-info-category
'((t (:weight bold :underline 't)))
"Face for category name in book info buffer."
:group 'fb2-reader)
(defvar fb2-reader-index-filename "index.el"
"Filename for file containing meta information about cached books.")
(defvar fb2-reader-position-filename "positions.el"
"Filename for file containing last positions in books.")
(defvar fb2-reader-link-map
(let ((map (make-sparse-keymap)))
(define-key map [follow-link] 'mouse-face)
(define-key map "\r" 'fb2-reader-follow-link)
(define-key map [mouse-2] 'fb2-reader-follow-link)
map))
(defvar fb2-reader-face-heights nil
"Variable to put face heights on async rendering.
Variable should be setted only in async process.")
(defvar-local fb2-reader-file-name nil
"Book's filename (replaces buffer-file-name).")
(defvar-local fb2-reader-link-pos nil
"Last used link's position.")
(defvar-local fb2-reader-link-target-pos nil
"Last used link's target.")
(defvar-local fb2-reader-header-line-toc nil
"List of chapters for header line.")
(defvar-local fb2-reader-toc-fb2-buffer nil
"In outline this var holds name of the fb2-reader buffer.")
(defvar-local fb2-reader-toc-fb2-window nil
"In outline this var holds name of the fb2-reader window.")
(defvar-local fb2-reader-rendering-future nil
"Rendering future for current buffer")
(defvar-local fb2-reader--link-is-visible-p nil
"Keeps result of previous execution of `fb2-reader-visible-link-p'")
(defconst fb2-reader-header-line-format
'(:eval (list (propertize " " 'display '((space :align-to 0)))
(fb2-reader-header-line-text))))
(defvar display-line-numbers-mode)
;; Appearance settings
(defgroup fb2-reader-appearance nil
"Variables controlling book's appearance.
Faces, indents, etc."
:group 'fb2-reader)
(defvar fb2-reader-face-names
'(fb2-reader-default
fb2-reader-title
fb2-reader-poem
fb2-reader-cite
fb2-reader-text-author)
"List of names, should be injected into async processes.")
(defcustom fb2-reader-default-indent 0
"Indent for plain text in document."
:type 'int
:group 'fb2-reader-appearance)
(defcustom fb2-reader-default-alignment 'full
"Aligment for plain text in document."
:type '(choice (const :tag "Full" full)
(const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-default
'((t (:inherit default)))
"Default face for fb2-reader buffer."
:group 'fb2-reader-appearance)
(defcustom fb2-reader-title-indent 2
"Indent for plain text in document."
:type 'int
:group 'fb2-reader-appearance)
(defcustom fb2-reader-title-alignment 'full
"Aligment for titles in document."
:type '(choice (const :tag "Full" full)
(const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-title
'((t (:height 1.4 :inherit fb2-reader-default)))
"Face for titles in fb2-reader buffer."
:group 'fb2-reader-appearance)
(defcustom fb2-reader-poem-indent 0
"Indent for plain text in document."
:type 'int
:group 'fb2-reader-appearance)
(defcustom fb2-reader-poem-alignment 'full
"Aligment for poems in document."
:type '(choice (const :tag "Full" full)
(const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-poem
'((t (:inherit fb2-reader-default)))
"Face for poem tag in fb2-reader buffer."
:group 'fb2-reader-appearance)
(defcustom fb2-reader-cite-indent 4
"Indent for plain text in document."
:type 'int
:group 'fb2-reader-appearance)
(defcustom fb2-reader-cite-alignment 'full
"Aligment for cites in document."
:type '(choice (const :tag "Full" full)
(const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-cite
'((t (:inherit fb2-reader-default)))
"Face for cite tag in fb2-reader buffer."
:group 'fb2-reader-appearance)
(defcustom fb2-reader-header-line-indent 2
"Indent for plain text in document."
:type 'int
:group 'fb2-reader-appearance)
(defcustom fb2-reader-header-line-alignment 'center
"Aligment for titles in document."
:type '(choice (const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-header-line
'((t (:height 1.4 :inherit header-line)))
"Face for header line with current title."
:group 'fb2-reader-appearance)
(defcustom fb2-reader-text-author-alignment 'right
"Aligment for text author's name in document."
:type '(choice (const :tag "Full" full)
(const :tag "Left" left)
(const :tag "Right" right)
(const :tag "Center" center))
:group 'fb2-reader-appearance)
(defface fb2-reader-text-author
'((t (:inherit fb2-reader-default)))
"Face for cite tag in fb2-reader buffer."
:group 'fb2-reader-appearance)
(defface fb2-reader-link
'((t (:inherit link)))
"Face for links in fb2-reader buffer."
:group 'fb2-reader-appearance)
;; Fb2 parsing
(defun fb2-reader-parse (book item &optional tags face alignment indent)
"Recursively parse ITEM and insert it into the buffer.
BOOK is whole xml tree (it is needed in case)"
(or face (setq face '((:inherit fb2-reader-default))))
(or tags (setq tags '()))
;; (or alignment (setq alignment 'left))
(or alignment (setq alignment 'full))
(or indent (setq indent 0))
(if (stringp item)
(insert (propertize (string-trim item)
'face face
'fb2-reader-tags tags))
(let ((current-tag (cl-first item))
(attributes (cl-second item))
(body (cddr item)))
(cond ((equal current-tag 'text-author)
(fb2-reader--format-string book body tags face current-tag fb2-reader-text-author-alignment indent))
((equal current-tag 'section)
(fb2-reader--parse-section book attributes body tags face current-tag))
((equal current-tag 'poem)
(fb2-reader--parse-poem book body tags))
((equal current-tag 'title)
(fb2-reader--parse-title book body tags))
((equal current-tag 'cite)
(fb2-reader--parse-cite book body tags))
((equal current-tag 'empty-line)
(insert (propertize "\n" 'fb2-reader-tags (cons 'empty-line tags))))
((equal current-tag 'image)
;; Disabled due new async rendering function
;; (fb2-reader--parse-image book attributes tags)
(fb2-reader--pickle-image book attributes tags))
((equal current-tag 'a)
(fb2-reader--parse-a-link book attributes body tags face current-tag))
((equal current-tag 'p)
(fb2-reader--format-string book body tags
face current-tag alignment indent))
((equal current-tag 'v)
(fb2-reader--format-string book body tags
face current-tag alignment indent))
((equal current-tag 'strong)
(fb2-reader-parse book (cl-first body) tags (cons 'bold face)))
((equal current-tag 'emphasis)
(fb2-reader-parse book (cl-first body) tags (cons 'italic face)))
('t
(dolist (subitem body)
(fb2-reader-parse book subitem (cons current-tag tags) face)))))))
(defun fb2-reader-face-heights ()
"Get alist with pairs of face names and their heights.
Order of elements should be persistent: it should be as in
`fb2-reader-face-names'. If variable with same name is not nil
it should happen only when function executed inside async process
return that variable, otherwise calculate heights."
(if (null fb2-reader-face-heights)
(let (face-heights)
(dolist (name fb2-reader-face-names)
(push (cons name (fb2-reader-get-face-height name))
face-heights))
face-heights)
fb2-reader-face-heights))
(defun fb2-reader-get-face-height (face)
"Take font height from FACE. Face can be face or alist."
(let ((height 1)
height-curr)
(if (listp face) (setq face (car (alist-get :inherit face))))
(while (and face (not (equal face 'unspecified)))
(setq height-curr (face-attribute face :height))
(if (equal height-curr 'unspecified)
(setq height-curr 1.0))
(setq height (* height(if (and (not (eq height-curr 1)) (integerp height-curr))
(/ height-curr (face-attribute 'default :height))
height-curr))
face (face-attribute face :inherit)))
height))
(defun fb2-reader-fc-for-face (face)
"Calculate `fill-column' value for FACE.
Needed in case face sets width != 1.
FACE can be a face or list of face attributes.
In second case height of the face in :inherit alist will be
taken into account."
(if (listp face) (setq face (car (alist-get :inherit face))))
(let ((height (alist-get face (fb2-reader-face-heights))))
;; For some reason on width near 1.2 rendered page became little
;; widthier than it should be. 0.96 coefficient should solve it.
;; sorry for dirty hack:(
(round (* 0.96 (/ fb2-reader-page-width height)))))
(defun fb2-reader--format-string (book body tags face curr-tag alignment indent &optional indent-first append-newline)
"Format BODY according to FACE, ALIGNMENT and INDENT and insert it.
BOOK is whole book xml tree, TAGS - fb2 tags, CURR-TAG - current fb2 tag."
(or indent-first (setq indent-first (if (eq alignment 'center) 0 2)))
(or append-newline (setq append-newline 't))
(let* ((point-start (point))
(indent (+ indent 1))
;; 1 appended to indent because of unwanted behavior
;; of fill-paragraph function. If fill-prefix equals
;; nil or "" fill-paragraph uses spaces at
;; beginning of the string as fill-prefix. If fill
;; prefix is not empty it works as expected.
(prefix (string-join (make-list indent " ")))
(prefix-first (string-join (make-list (+ indent indent-first) " ")))
(fill-column (- (fb2-reader-fc-for-face face) indent)))
(insert (propertize prefix-first 'fb2-reader-tags tags))
(dolist (subitem body)
(fb2-reader-parse book subitem (cons curr-tag tags) face alignment indent))
(if append-newline
(insert (propertize "\n" 'fb2-reader-tags tags)))
(setq fill-prefix prefix)
(fill-region point-start (point) alignment)
(if (and
(eq alignment 'center)
;; Check below means face's height not equal 1
(not (equal fill-column fb2-reader-page-width)))
(fb2-reader--recenter-region point-start (point)
(alist-get (car (alist-get :inherit face)) (fb2-reader-face-heights))))))
(defun fb2-reader--center-prefix (linelen strlen height)
"Calculate number of spaces needed to center string.
String to center has STRLEN symbols, every symbol has HEIGHT.
LINELEN is maximum line's length (page width)"
(round (/ (- linelen (* strlen height)) 2)))
(defun fb2-reader--recenter-region (begin end height)
"Recenter region from BEGIN to END.
HEIGHT is font's height (should be coefficient).
Every string's length in region should be less or equal fill column.
Because of strange `fill-region' behavior every line in region should
be recenered \(For some reason when `fill-region' invoked inside
fb2r-format-string,every space or tab added to line not inherit
:height property, and resulting line length became longer or shorter
than planned\)"
(let ((lines (number-sequence (line-number-at-pos begin)
(line-number-at-pos end)))
linestr prefix)
(save-excursion
(dolist (linenum lines)
(goto-char (point-min))
(forward-line (1- linenum))
(setq linestr (s-trim (s-collapse-whitespace
(buffer-substring
(point)
(progn
(move-end-of-line 1) (point))))))
(when (> (length linestr) 0)
(setq prefix (fb2-reader--center-prefix fb2-reader-page-width (length linestr) height))
(move-beginning-of-line 1)
(kill-line)
(insert (s-repeat prefix " "))
(insert linestr))))))
(defun fb2-reader--insert-newline-maybe ()
"Insert newline if there is no newline inserted before.
Exception for \"empty-line\" tag."
(let (already-added)
(save-excursion
(backward-char)
(setq already-added
(and (equal (char-before) 10)
(equal (char-after) 10))))
(unless already-added
(insert (propertize "\n" 'fb2-reader-tags '(empty-line-special))))))
(defun fb2-reader--parse-section (book attributes body tags face curr-tag)
"Parse section, add fb2-reader-id text property if id found in ATTRIBUTES.
BOOK is whole book xml tree, TAGS - fb2 tags, CURR-TAG - current fb2 tag."
(let ((start (point))
(id (alist-get 'id attributes)))
(dolist (subitem body)
(fb2-reader-parse book subitem (cons curr-tag tags) face))
(when id
(add-text-properties start (point) (list 'fb2-reader-id (intern id))))))
(defun fb2-reader--parse-title (book body tags)
"Parse and insert BODY (BOOK\'s part) as title."
(let* ((face '((:inherit fb2-reader-title)))
start
end)
(when (> (line-number-at-pos) 1) ;don't insert separator if this is first title
(insert "\n\n"))
(setq start (point))
(dolist (subitem body)
(fb2-reader-parse book subitem (cons 'title tags) face
fb2-reader-title-alignment
fb2-reader-title-indent))
(setq end (point))
(insert "\n")
(add-text-properties start end '(fb2-reader-title t))))
(defun fb2-reader--parse-cite (book body tags)
"Parse BODY as cite and insert it.
BOOK is whole book xml tree, TAGS - fb2 tags."
(let* ((indent fb2-reader-cite-indent)
(align fb2-reader-cite-alignment)
(face '((:inherit fb2-reader-cite))))
(fb2-reader--insert-newline-maybe)
(dolist (subitem body)
(fb2-reader-parse book subitem (cons 'cite tags) face align indent))
(fb2-reader--insert-newline-maybe)))
(defun fb2-reader--parse-poem (book body tags)
"Parse BODY as poem and insert it.
BOOK is whole book xml tree, TAGS - fb2 tags."
(dolist (subitem body)
(let ((subtags (cons 'poem tags))
(subtag (cl-first subitem))
(face '((:inherit fb2-reader-poem))))
(if (equal subtag 'stanza)
(fb2-reader--insert-newline-maybe))
(fb2-reader-parse book subitem (cons subtag subtags) face
fb2-reader-poem-alignment
fb2-reader-poem-indent)))
(insert (propertize "\n" 'fb2-reader-tags '('empty-line-special))))
(defun fb2-reader--pickle-image (book attributes tags)
"Save all image-related info from BOOK ATTRIBUTES and TAGS to text property.
It should be rendered when propertized text will be inserted into buffer."
(when-let* ((imgdata (fb2-reader--extract-image-data book attributes tags))
(type-str (cl-first imgdata))
(data-str (cl-second imgdata))
(tags (cl-third imgdata)))
(insert (propertize " "
'fb2-reader-image-type type-str
'fb2-reader-image-data data-str
'fb2-reader-tags tags))))
(defun fb2-reader--extract-image-data (book attributes &optional tags)
"Parse image ATTRIBUTES and return image related data.
List of type string, binary data string, and tags will be returned.
BOOK is whole book's xml tree. TAGS are list of fb2 tags."
(when-let* ((id (replace-regexp-in-string "#" "" (cdr (car attributes))))
(binary (fb2-reader--find-binary book id))
(type-str (alist-get 'content-type (cl-second binary)))
(data-str (cl-third binary)))
(list type-str data-str tags)))
(defun fb2-reader--insert-image (data type &optional tags use-prefix)
"Generate image from DATA of type TYPE and insert it at point.
Property fb2-reader-tags will be set to TAGS and appended
to placeholder.
Center image if USE-PREFIX."
;; TODO: add alignment
(when-let* ((type-char (alist-get type
'(("image/jpeg" . jpeg) ("image/png" . png))
nil nil 'equal))
(data-decoded (base64-decode-string data))
(img-raw (fb2-reader--create-image data-decoded type-char))
(size-raw (image-size img-raw 't))
(img-adj (fb2-reader--create-image data-decoded type-char
:max-width fb2-reader-image-max-width
:max-height fb2-reader-image-max-height))
(width-ch (car (image-size img-adj)))
(prefix-num (round (/ (- fb2-reader-page-width width-ch) 2)))
(prefix-str (string-join (make-list prefix-num " ")))
(fill-str (propertize " " 'fb2-reader-tags (cons 'image tags)
'fb2-reader-image-params size-raw)))
(insert "\n")
(if use-prefix
(insert prefix-str))
(insert-image img-adj fill-str)
(insert "\n")))
(defun fb2-reader-restore-images (&optional buffer)
"Find all images pickled in BUFFER and restore them."
(interactive)
(or buffer (setq buffer (current-buffer)))
(with-current-buffer buffer
(goto-char (point-min))
(while (not (eobp))
(let ((next-change (or (next-single-property-change (point) 'fb2-reader-image-data)
(point-max)))
(plist (text-properties-at (point)))
image-data
image-type
tags)
(when (plist-member plist 'fb2-reader-image-data)
(setq image-data (plist-get plist 'fb2-reader-image-data)
image-type (plist-get plist 'fb2-reader-image-type)
tags (plist-get plist 'fb2-reader-tags))
(delete-char 1)
(fb2-reader--insert-image image-data image-type tags 't))
(goto-char next-change)))))
(defun fb2-reader--find-binary (book id)
"Find binary with ID in BOOK."
(fb2-reader--find-subitem book 'binary 'id id))
;; In case I'll need seamlessly switch image backend to imagemagick or something
(defun fb2-reader--create-image (data type &rest props)
"Create image of type TYPE from image DATA."
(apply #'create-image data type 't props))
;; Parse metadata (everything inside description tag)
(defun fb2-reader-parse-metadata (book item)
"Parse ITEM and insert as fb2 metadata.
BOOK should contain whole book's xml tree."
(let ((current-tag (cl-first item))
;; (attributes (cl-second item))
(body (cddr item)))
(cond ((member current-tag '(history annotation))
(fb2-reader--parse-rich-text item))
((member current-tag '(author translator))
(fb2-reader--parse-person item))
((equal current-tag 'sequence)
(fb2-reader--parse-sequence item))
((equal current-tag 'coverpage)
(fb2-reader--parse-cover book item))
(t
(if (> (length body) 1)
(progn (insert (format "\n%s\n" (fb2-reader--format-symbol current-tag 'fb2-reader-info-category)))
(dolist (subitem body)
(fb2-reader-parse-metadata book subitem)))
(insert (format "%s: %s\n" (fb2-reader--format-symbol current-tag 'fb2-reader-info-field) (if (stringp (car body)) (car body) " -"))))))))
(defun fb2-reader--format-symbol (symbol face)
"Take SYMBOL, transform it it readable string and apply FACE."
(let ((prop (cond ((equal face 'fb2-reader-info-field)
'fb2-reader-info-field)
((equal face 'fb2-reader-info-category)
'fb2-reader-info-category))))
(propertize (s-capitalize (s-replace "-" " " (symbol-name symbol)))
'face face prop t)))
(defun fb2-reader--parse-person (item)
"Parse ITEM and insert as some person's data (author or translator).
FIELD-NAME is what shold be in left of : when name is printed."
(let* ((fields (cddr item))
(name (s-join " " (-non-nil (list (cl-second (alist-get 'first-name fields))
(cl-second (alist-get 'middle-name fields))
(cl-second (alist-get 'nick fields))
(cl-second (alist-get 'last-name fields)))))))
(if name (insert (format "%s: %s\n" (fb2-reader--format-symbol (cl-first item) 'fb2-reader-info-field-face) name)))
(dolist (field fields)
(when (not (member (cl-first field) '(first-name middle-name nick last-name)))
(insert (format " %s: %s\n" (fb2-reader--format-symbol (cl-first field) 'fb2-reader-info-field-face) (cl-third field)))))))
(defun fb2-reader--parse-rich-text (item)
"Parse ITEM as field with rich text inside."
(let* ((field-name (s-capitalize (symbol-name (cl-first item))))
(fname-length (length field-name))
(start (point))
end)
(fb2-reader-parse nil item nil nil 'full (+ 2 fname-length))
(setq end (point))
(save-excursion
(goto-char start)
(insert (format "%s:" (propertize field-name 'face 'fb2-reader-info-field-face 'fb2-reader-info-field 't)))
(while (<= (line-number-at-pos (point)) (line-number-at-pos end))
(forward-line 1)
(insert (s-repeat (1+ fname-length) " "))))))
(defun fb2-reader--parse-sequence (item)
"Parse ITEM as sequence and insert it at point."
(let* ((attributes (cl-second item))
(field-name (fb2-reader--format-symbol (cl-first item) 'fb2-reader-info-field-face))
(name (alist-get 'name attributes))
(number (alist-get 'number attributes)))
(insert (format "%s: %s" field-name name))
(if number (insert (format "(%s)" number)))
(insert "\n")))
(defun fb2-reader--parse-cover (book item)
"Get image attrs from ITEM, find image in BOOK and insert it."
(let* ((attrs (cl-second (cl-third item)))
(imgdata (fb2-reader--extract-image-data book attrs))
(type-str (cl-first imgdata))
(data-str (cl-second imgdata))
(covername (fb2-reader--format-symbol (cl-first item) 'fb2-reader-info-field-face)))
(insert (format "%s:\n" covername))
(fb2-reader--insert-image data-str type-str)
(insert "\n")))
;; Splash screen
(defun fb2-reader-splash-text (item)
"Insert splash screent text.
If no custom text, take text's language from ITEM."
(if (not (null fb2-reader-splash-text))
fb2-reader-splash-text
(let ((lang (if (null item) "en" (cl-third item))))
(fb2-reader-splash-text-for-lang lang))))
(defun fb2-reader-splash-text-for-lang (lang)
"Get splash text depending on LANG."
(cond
;; ((equal lang "ab")) ;; Abhazia
((equal lang "az")
"Yüklənir Zəhmət olmasa gözləyin. ")
((equal lang "sq")
"Duke u ngarkuar, ju lutem prisni.")
((equal lang "en")
"Loading, please wait.")
((equal lang "hy")
"Բեռնվում է, խնդրում ենք սպասել.")
((equal lang "be")
"Ідзе загрузка, калі ласка, пачакайце.")
((equal lang "bg")
"Зареждане, моля, изчакайте.")
((equal lang "hu")
"Betöltés; kérem várjon.")
((equal lang "vi")
"Tải vui lòng đợi.")
((equal lang "nl")
"Laden even geduld aub.")
((equal lang "el")
"Φορτώνει παρακαλώ περιμένετε.")
;; ((equal lang "he")
;; "טוען אנא המתן.") ;;Israel
((equal lang "es")
"Cargando, por favor espere.")
((equal lang "it")
"Caricamento in corso, attendere prego.")
((equal lang "kk")
"Жүктелуде, күте тұрыңыз.")
((equal lang "ky")
"Жүктөлүүдө, күтө туруңуз.")
((equal lang "zh")
"加载请稍候")
((equal lang "ko")
"로딩 중 기다려주세요.")
((equal lang "la")
"Onerans, obsecro, expecta.")
((equal lang "lv")
"Iekraušana, lūdzu, uzgaidiet.")
((equal lang "lt")
"Pakraunama, palaukite.")
((equal lang "mk")
"Се вчитува, Ве молиме почекајте.")
;; ((equal lang "mo")) ;; Moldavia
((equal lang "mn")
"Ачаалж байна, түр хүлээнэ үү.")
((equal lang "de")
"Wird geladen, bitte warten.")
((equal lang "no")
"Laster Vennligst vent.")
;; ((equal lang "fa")
;; "در حال بارگذاری لطفا صبر کنید.") ;; Persian
((equal lang "pl")
"Ładowanie, proszę czekać.")
((equal lang "pt")
"Carregamento, aguarde, por favor.")
((equal lang "ru")
"Загружается, пожалуйста, подождите.")
;; ((equal lang "sa")) ;; Sanscrit
((equal lang "sk")
"Načítava sa, počkajte, prosím.")
((equal lang "sl")
"Načítava sa, počkajte, prosím.")
((equal lang "tg")
"Бор карда мешавад, лутфан интизор шавед.")
((equal lang "tt")
"Йөкләү, зинһар, көтегез.")
((equal lang "tr")
"Yükleniyor lütfen bekleyin.")
((equal lang "uz")
"Yuklanmoqda, kuting.")
((equal lang "uk")
"Завантаження, будь ласка, зачекайте.")
;; ((equal lang "cy")) ;; Wels
((equal lang "fi")
"Ladataan, odota.")
((equal lang "fr")
"Chargement, veuillez patienter.")
((equal lang "cs")
"Načítá se, vyčkejte prosím.")
((equal lang "sv")
"Laddar, vänligen vänta.")
((equal lang "eo")
"Ŝarĝante, bonvolu atendi.")
((equal lang "ja")
"読み込み中。。。待って下さい。")
((equal lang "et")
"Laadimine, palun oodake.")
(t
"Loading, please wait.")))
(defun fb2-reader-splash-title (item)
"Insert title taken from ITEM."
(let ((title (cl-third item)))
(insert (propertize title 'face 'fb2-reader-title))
(newline)))
(defun fb2-reader-splash-cover (book item)
"Insert cover for splash screen.
Take cover from BOOK according to data in ITEM."
;; when-let used in case we have empty coverpage tag, then function
;; just skipped image processing
(when-let* ((attrs (cl-second (cl-third item)))
(imgdata (fb2-reader--extract-image-data book attrs))
(type-str (cl-first imgdata))
(data-str (cl-second imgdata)))
(fb2-reader--insert-image data-str type-str nil t)
(newline)))
(defun fb2-reader-splash-author (item)
"Insert author's name, taken from ITEM."
(let* ((fields (cddr item))
(name (s-join " " (-non-nil (list (cl-second (alist-get 'first-name fields))
(cl-second (alist-get 'middle-name fields))
(cl-second (alist-get 'nick fields))
(cl-second (alist-get 'last-name fields)))))))
(when name
(insert (propertize name 'face 'fb2-reader-title))
(newline))))
(defun fb2-reader-splash-screen (book)
"Insert loading screen for BOOK."
(let ((fill-column fb2-reader-page-width)
(title-item (fb2-reader--get-title book))
(cover-item (fb2-reader--get-cover book))
(name-item (fb2-reader--get-author book))
(lang-item (fb2-reader--get-lang book))
(start (point))
(height (face-attribute 'fb2-reader-title :height))
(splash-height (face-attribute 'fb2-reader-title :height)))
(if name-item (fb2-reader-splash-author name-item))
(if title-item (fb2-reader-splash-title title-item))
(fb2-reader--recenter-region start (point) height)
(if cover-item (fb2-reader-splash-cover book cover-item))
(setq start (point))
(insert (propertize (fb2-reader-splash-text lang-item)
'face 'fb2-reader-splash))
(fb2-reader--recenter-region start (point-max) splash-height)))
;; Links
(defun fb2-reader--parse-a-link (book attributes body tags face curr-tag)
"Parse and insert link described with ATTRIBUTES from BOOK."
(let ((id (intern (replace-regexp-in-string "#" "" (cdr (car attributes)))))
(start (point))
(link-face (cons (cons :inherit (list 'link)) face)))
(dolist (subitem body)
(fb2-reader-parse book subitem (cons curr-tag tags) link-face))
(add-text-properties start (point)
(list 'fb2-reader-target id
'follow-link t
'keymap fb2-reader-link-map
'mouse-face 'highlight))))
(defun fb2-reader--get-target-pos (id)
"Get target position for link with certain ID."
(save-excursion
(goto-char (point-min))
(let (link-found next-change plist target-pos)
(while (not (or link-found (eobp)))
(setq next-change (or (next-single-property-change (point) 'fb2-reader-id)
(point-max))
plist (text-properties-at (point))
link-found (equal id (plist-get plist 'fb2-reader-id))
target-pos (point))
(goto-char next-change))
(if link-found target-pos))))
(defun fb2-reader-follow-link ()
"Follow link under point."
(interactive)
(push-mark)
(when-let* ((target-id (get-text-property (point) 'fb2-reader-target))
(position (fb2-reader--get-target-pos target-id)))
(setq fb2-reader-link-pos (point))
(goto-char position)
(setq fb2-reader-link-target-pos (point))
(recenter 0)))
(defun fb2-reader-link-back ()
"Go to last used link's location."
(interactive)
(if fb2-reader-link-pos
(goto-char fb2-reader-link-pos)
(user-error "This is first element in history")))
(defun fb2-reader-link-forward ()
"Go to last used link's location."
(interactive)
(if fb2-reader-link-pos
(goto-char fb2-reader-link-target-pos)
(user-error "This is last element in history")))
(defun fb2-reader--find-subitem (item tag &optional property value)
"Find first ITEM\'s child with TAG.
Founded item should have PROPERTY with certain VALUE,
if these parameters are set."
(if (listp item)
(catch 'subitem (progn (dolist (subitem item)
(if (and
(listp subitem)
(equal (cl-first subitem) tag)
(or (not property)
(and (listp (cl-second subitem))
(equal value (alist-get property (cl-second subitem))))))
(throw 'subitem subitem)))
nil))))
(defun fb2-reader--find-subitem-recursively (item &rest tags)
"Trawerse by the chain of the tags in ITEM.
TAGS are list of the tags. First function founds first tag from the list,
then found second tag in subitem and so on."
(let (curr-item)
(setq curr-item item)
(dolist (tag tags curr-item)
(setq curr-item (fb2-reader--find-subitem curr-item tag)))))
(defun fb2-reader--get-bodies (book)
"Get list of all bodies from the BOOK."
(let (bodies)
(dolist (item (cddr book))
(if (equal (cl-first item) 'body)
(push item bodies)))
(reverse bodies)))
(defun fb2-reader--get-description (book)
"Get description node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description))
(defun fb2-reader--get-title (book)
"Get title node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'title-info 'book-title))
(defun fb2-reader--get-author (book)
"Get author node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'title-info 'author))
(defun fb2-reader--get-cover (book)
"Get cover node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'title-info 'coverpage))
(defun fb2-reader--get-annotation (book)
"Get annotation node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'title-info 'annotation))
(defun fb2-reader--get-lang (book)
"Get lang node from BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'title-info 'lang))
(defun fb2-reader--get-program (book)
"Get program used to generate BOOK."
(fb2-reader--find-subitem-recursively (cddr book) 'description 'document-info 'program-used))
(defun fb2-reader-render-html (book)
"Render2 BOOK and insert it into the current buffer."
(setq-local fill-column fb2-reader-page-width)
(dolist (item (cdddr book))
(fb2-reader-parse book item)))
(defun fb2-reader-render-xml (book)