1 files changed, 95 insertions, 3 deletions
diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el
index 89f27c0..829ebcb 100644
--- a/emacs/.emacs.d/lisp/my/belf.el
+++ b/emacs/.emacs.d/lisp/my/belf.el
@@ -100,15 +100,107 @@
       (json-read)))
   )
 
+(defun belf-epub-content-file-name (file-name)
+  (with-temp-buffer
+    (call-process "unzip" nil t nil "-p" file-name "META-INF/container.xml")
+    (let ((dom (libxml-parse-xml-region (point-min) (point-max))))
+      (dom-attr (dom-by-tag (dom-by-tag (dom-by-tag dom 'container) 'rootfiles) 'rootfile) 'full-path))))
+
+(defun belf-epub-cover-file-name (file-name content-file-name)
+  (with-temp-buffer
+    (call-process "unzip" nil t nil "-p" file-name content-file-name)
+    (let* ((dom (libxml-parse-xml-region (point-min) (point-max)))
+           (metas
+            (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'metadata) 'meta))
+           (items
+            (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'manifest) 'item))
+           cover-name
+           cover-file)
+      (while (and metas (not cover-name))
+        (let-alist (cadr (car metas))
+          (when (equal .name "cover")
+            (setq cover-name .content)))
+        (setq metas (cdr metas)))
+      (while (and items (not cover-file))
+        (let-alist (cadr (car items))
+          (when (equal .id cover-name)
+            (setq cover-file .href)))
+        (setq items (cdr items)))
+      (cond (cover-file
+             (file-name-concat (file-name-directory content-file-name)
+                               cover-file))
+            ;; If no cover-file, then try cover-name if it looks like
+            ;; an image file path
+            ((string-match-p belf-book-cover-re cover-name)
+             (file-name-concat (file-name-directory content-file-name)
+                               cover-name)))
+      )))
+
+(defvar belf-book-cover-exts '("jpg" "png" "jpeg"))
+(defvar belf-book-cover-re
+  (concat "^.*\\." (regexp-opt belf-book-cover-exts) "$"))
+
+(defun belf-locate-book-cover (file-name)
+  (let ((exts belf-book-cover-exts)
+        cover-file-name
+        found)
+    (while (and exts (not found))
+      (setq cover-file-name (file-name-with-extension file-name (car exts))
+            exts (cdr exts)
+            found (file-exists-p cover-file-name)))
+    (when found cover-file-name)))
+
 (defun belf-book-cover (file-name)
   "Get book cover.
 
 First look for an image file with the same file name.
 Then for PDF, extract the first page.
 For EPUB, looks for a cover image in the file. If not found, extract the first page."
-  (cond ((file-exists-p (file-name-with-extension file-name "jpg"))
-         (format "file://%s" (file-name-with-extension file-name "jpg")))
-        (t nil)))
+  (when-let ((cover-file-name (belf-locate-book-cover file-name)))
+    (concat "file://" cover-file-name))
+  (when (equal "epub" (file-name-extension file-name))
+    (let* ((content-file-name (belf-epub-content-file-name file-name))
+           (cover-file
+            (belf-epub-cover-file-name file-name content-file-name))
+           (cover-file-name (file-name-with-extension
+                             file-name
+                             (file-name-extension cover-file))))
+      (call-process "unzip" nil `(:file ,cover-file-name) nil
+                    "-p" file-name cover-file)
+      (concat "file://" cover-file-name)))
+  ;; (with-temp-buffer
+  ;;   (let ((content-file-name))
+  ;;     (call-process "unzip" nil t nil "-p" file-name content-file-name)
+  ;;     (let* ((dom (libxml-parse-xml-region (point-min) (point-max)))
+  ;;            (metas
+  ;;             (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'metadata) 'meta))
+  ;;            (items
+  ;;             (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'manifest) 'item))
+  ;;            cover-name
+  ;;            cover-file
+  ;;            cover-file-name)
+  ;;       (while (and (cdr metas) (not cover-name))
+  ;;         (let-alist (cadr (car metas))
+  ;;           (when (equal .name "cover")
+  ;;             (setq cover-name .content)))
+  ;;         (setq metas (cdr metas)))
+  ;;       (while (and (cdr items) (not cover-file))
+  ;;         (let-alist (cadr (car items))
+  ;;           (when (equal .id cover-name)
+  ;;             (setq cover-file .href)))
+  ;;         (setq items (cdr items)))
+  ;;       (when cover-file
+  ;;         (setq cover-file
+  ;;               (concat (or (file-name-directory content-file-name) "")
+  ;;                       cover-file)))
+  ;;       (setq cover-file-name
+  ;;             (file-name-with-extension
+  ;;              file-name
+  ;;              (file-name-extension cover-file)))
+  ;;       (call-process "unzip" nil `(:file ,cover-file-name) nil
+  ;;                     "-p" file-name cover-file)
+  ;;       (concat "file://" cover-file-name))))
+  )
 
 (defun belf-book-infobox-at-point ()
   (interactive)