From 71021e3085f8f17adeffd03c28c9b6ded42b5051 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sun, 9 Feb 2025 10:53:39 +1100 Subject: [emacs] belf mode show book cover in the infobox --- emacs/.emacs.d/init/ycp-prog.el | 3 +- emacs/.emacs.d/lisp/my/belf.el | 98 +++++++++++++++++++++++++++++++++++++-- emacs/.emacs.d/lisp/my/infobox.el | 8 +++- 3 files changed, 103 insertions(+), 6 deletions(-) (limited to 'emacs') diff --git a/emacs/.emacs.d/init/ycp-prog.el b/emacs/.emacs.d/init/ycp-prog.el index 3209e81..6584491 100644 --- a/emacs/.emacs.d/init/ycp-prog.el +++ b/emacs/.emacs.d/init/ycp-prog.el @@ -550,7 +550,8 @@ ;;; nxml (my-package nxml-mode (:delay 60) - (setq nxml-slash-auto-complete-flag t)) + (setq nxml-slash-auto-complete-flag t) + (add-to-list 'auto-mode-alist '("\\.opf\\'" . nxml-mode))) (my-package etags (:delay 60) 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) diff --git a/emacs/.emacs.d/lisp/my/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el index 2a17dc9..0e5e054 100644 --- a/emacs/.emacs.d/lisp/my/infobox.el +++ b/emacs/.emacs.d/lisp/my/infobox.el @@ -70,8 +70,12 @@ something like ;; TODO: use a more standard function than ;; `my-make-filename-from-url' (when-let* ((thumb-url (alist-get "Thumbnail" info nil nil 'equal)) - (file-name (make-temp-name "/tmp/infobox-"))) - (url-copy-file thumb-url file-name t) + (file-name + (if (string-prefix-p "file://" thumb-url) + (string-remove-prefix "file://" thumb-url) + (make-temp-name "/tmp/infobox-")))) + (unless (string-prefix-p "file://" thumb-url) + (url-copy-file thumb-url file-name t)) (insert-image (create-image file-name nil nil :max-width (window-pixel-width) :max-height (/ (window-pixel-height) 2))) -- cgit v1.2.3