;;; belf.el -- Bookshelf, ebook library management -*- lexical-binding: t -*- ;; Copyright (C) 2025 Free Software Foundation, Inc. ;; Author: Yuchen Pei ;; Package-Requires: ((emacs "29.4")) ;; This file is part of dotted. ;; dotted is free software: you can redistribute it and/or modify it under ;; the terms of the GNU Affero General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; dotted 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 Affero General ;; Public License for more details. ;; You should have received a copy of the GNU Affero General Public ;; License along with dotted. If not, see . ;;; Commentary: ;; Bookshelf, ebook library management. ;;; Code: (require 'tabulated-list) (require 'infobox) (defvar-keymap belf-mode-map :parent tabulated-list-mode-map "F" #'belf-toggle-follow-mode "d" #'belf-show-in-dired "i" #'belf-book-infobox-at-point "n" #'belf-next-line "o" #'belf-open-book-other-window "p" #'belf-previous-line "RET" #'belf-open-book ) (define-derived-mode belf-mode tabulated-list-mode "Bookshelf" "Major mode for browsing a list of books." (setq tabulated-list-format [("Authors" 25 t) ("Title" 48 t) ("Year" 4 t)]) (setq tabulated-list-padding 2) (tabulated-list-init-header) (setq revert-buffer-function #'belf-list-refresh-contents) (hl-line-mode)) (defun belf-list-books () (interactive) (let ((buf (get-buffer-create "*Bookshelf*"))) (with-current-buffer buf (belf-mode) (belf-list-refresh-contents)) (pop-to-buffer-same-window buf))) (defun belf-list-refresh-contents (&rest _) (setq-local tabulated-list-entries (belf-parse-all-file-names)) (tabulated-list-print)) (defvar belf-dir "~/Documents" "Directory of books.") (defun belf-parse-all-file-names () (seq-filter #'identity (seq-map (lambda (f) (when-let ((parsed (belf-parse-file-name f))) (let-alist parsed (list f (vector .authors .title .year))))) (directory-files belf-dir t "\\.\\(epub\\|pdf\\|mobi\\|cbr\\|djvu\\)$")))) (defun belf-parse-file-name (file-name) (let ((base (file-name-base file-name))) (when (string-match "^\\(.*?\\) - \\(.*\\) (\\([0-9]*\\))" base) `((authors . ,(match-string 1 base)) (title . ,(match-string 2 base)) (year . ,(match-string 3 base)))))) (defun belf-book-infobox (file-name) (interactive) (belf-book-render-info (belf-exiftool-info file-name) file-name)) (defvar belf-exiftool-program "exiftool" "The exiftool program.") (defun belf-exiftool-info (file-name) "Given a video URL, return an alist of its properties." (with-temp-buffer (call-process belf-exiftool-program nil t nil "-j" file-name) (let ((start (point))) (call-process-region nil nil "jq" nil t nil ".[0]|pick(.Title, .Author, .Creator, .Keywords, .Subject, .Publisher, .Identifier, .Series, .Title_sort, .Author_sort, .PageCount, .ISBN, .Language, .FileType, .Description)") (goto-char start) (json-read))) ) (defun belf-epub-content-file-name (file-name) (with-temp-buffer (if (eq 0 (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)) (message "Failed to extract container.xml: %s" (buffer-string)) nil))) (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 cover-file-from-prop) (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)) (when (equal .properties "cover-image") (setq cover-file-from-prop .href))) (setq items (cdr items))) (cond (cover-file (file-name-concat (file-name-directory content-file-name) cover-file)) (cover-file-from-prop (file-name-concat (file-name-directory content-file-name) cover-file-from-prop)) ((not cover-name) (message "Could not find cover in epub metadata.") nil) ;; 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-pdf-page-one-cover (file-name) "Extract the first page of a pdf file as cover." (let ((cover-file (file-name-with-extension file-name "jpg"))) (with-temp-buffer (if (eq 0 (call-process "gs" nil t t "-dNOPAUSE" "-dBATCH" "-sDEVICE=jpeg" "-r300" (format "-sOutputFile=%s" cover-file) "-dFirstPage=1" "-dLastPage=1" file-name)) cover-file (message "Failed to extract cover from PDF: %s" (buffer-string)) nil)))) (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-let ((cover-file-name (belf-locate-book-cover file-name))) (concat "file://" cover-file-name) (when (equal "epub" (file-name-extension file-name)) (when-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) (format "file://%s" cover-file-name))) (when (equal "pdf" (file-name-extension file-name)) (when (setq cover-file-name (belf-pdf-page-one-cover file-name)) (format "file://%s" cover-file-name)))) ) (defun belf-book-infobox-at-point () (interactive) (let ((help-window-select (not belf-follow-mode))) (belf-book-infobox (tabulated-list-get-id))) ) (defun belf-book-render-info (info file-name) (setf (alist-get 'Title info) (concat (alist-get 'Title info) " -- " (buttonize "xdg-open" (lambda (_) (call-process "xdg-open" nil 0 nil file-name))) " " (buttonize "find-file" (lambda (_) (find-file file-name)))) (alist-get 'Thumbnail info) (belf-book-cover file-name) (alist-get 'Description info) (when-let ((text (alist-get 'Description info))) (with-temp-buffer (insert (if (stringp text) text (prin1-to-string text))) (shr-render-region (point-min) (point-max)) (goto-char (point-min)) (insert "\n") (buffer-string)))) (infobox-render (infobox-translate info (infobox-default-specs info)) `(belf-book-infobox ,file-name) (called-interactively-p 'interactive))) (defvar belf-follow-mode nil "Whether follow mode is on.") (defun belf-toggle-follow-mode () (interactive) (setq belf-follow-mode (not belf-follow-mode))) (defun belf-previous-line () (interactive) (previous-line) (when belf-follow-mode (belf-book-infobox-at-point))) (defun belf-next-line () (interactive) (next-line) (when belf-follow-mode (belf-book-infobox-at-point))) (defun belf-show-in-dired () (interactive) (dired-jump-other-window (tabulated-list-get-id))) (defun belf-open-book () (interactive) (find-file (tabulated-list-get-id))) (defun belf-open-book-other-window () (interactive) (find-file-other-window (tabulated-list-get-id))) (provide 'belf)