aboutsummaryrefslogtreecommitdiff
path: root/emacs/.emacs.d/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'emacs/.emacs.d/lisp')
-rw-r--r--emacs/.emacs.d/lisp/my/belf.el451
-rw-r--r--emacs/.emacs.d/lisp/my/infobox.el27
-rw-r--r--emacs/.emacs.d/lisp/my/my-dired.el21
-rw-r--r--emacs/.emacs.d/lisp/my/my-emms.el68
-rw-r--r--emacs/.emacs.d/lisp/my/my-github.el4
-rw-r--r--emacs/.emacs.d/lisp/my/my-gitlab.el10
-rw-r--r--emacs/.emacs.d/lisp/my/my-gnus.el2
-rw-r--r--emacs/.emacs.d/lisp/my/my-libgen.el142
-rw-r--r--emacs/.emacs.d/lisp/my/my-nov.el12
-rw-r--r--emacs/.emacs.d/lisp/my/my-web.el32
10 files changed, 723 insertions, 46 deletions
diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el
new file mode 100644
index 0000000..4278927
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/belf.el
@@ -0,0 +1,451 @@
+;;; belf.el -- Bookshelf, ebook library management -*- lexical-binding: t -*-
+
+;; Copyright (C) 2025 Free Software Foundation, Inc.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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
+ "RET" #'belf-open-book
+ "b" #'tabulated-list-previous-column
+ "d" #'belf-show-in-dired
+ "f" #'tabulated-list-next-column
+ "i" #'belf-book-infobox-at-point
+ "n" #'belf-next-line
+ "o" #'belf-open-book-other-window
+ "p" #'belf-previous-line
+ "e" #'belf-set-field
+ "," #'belf-rename-desort-at-point
+ "E" #'belf-epub-rename-at-point
+ ;; "s" #'tabulated-list-col-sort
+ )
+
+(define-derived-mode belf-mode tabulated-list-mode "Bookshelf"
+ "Major mode for browsing a list of books."
+ (setq tabulated-list-format
+ [("Authors" 25 belf-compare-authors)
+ ("Title" 48 belf-compare-title)
+ ("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 ()
+ (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-library (dir)
+ (interactive (list (read-directory-name "Book directory: " belf-dir nil t)))
+ (setq belf-dir dir)
+ (belf))
+
+(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\\|cbr\\|djvu\\|mobi\\)$"))))
+
+(defun belf-file-name-desort (file-name new-dir)
+ "Rename a file.
+
+Change authors-sort to authors. Change title-sort to title.
+
+Test:
+foo bar
+foo, bar
+foo bar, quux baf
+foo, bar & quux, baf
+foo bar & quux, baf"
+ (when-let ((parsed (belf-parse-file-name file-name)))
+ (let* ((authors (string-split (alist-get 'authors parsed) " & " t " +"))
+ (title (alist-get 'title parsed)))
+ (setf
+ (alist-get 'authors parsed)
+ (mapconcat
+ (lambda (author)
+ (let ((comma-split (string-split author ", ")))
+ (if (or ;; no comma or more than one comma
+ (/= (length comma-split) 2)
+ ;; at least one space before the comma
+ (string-match-p " " (car comma-split)))
+ author
+ ;; from author-sort to author
+ (format "%s %s" (cadr comma-split) (car comma-split))
+ )))
+ authors
+ ", ")
+ (alist-get 'title parsed)
+ (cond ((string-suffix-p ", The" title)
+ (concat "The " (string-remove-suffix ", The" title)))
+ ((string-suffix-p ", A" title)
+ (concat "A " (string-remove-suffix ", A" title)))
+ (t title))))
+ (format "%s.%s"
+ (belf-format-base-name parsed new-dir)
+ (alist-get 'ext parsed))))
+
+(defun belf-rename-desort (file-name new-dir)
+ (when-let ((new-name (belf-file-name-desort file-name new-dir)))
+ (unless (equal new-name file-name)
+ (rename-file file-name new-name))))
+
+(defun belf-rename-desort-at-point ()
+ (interactive)
+ (let ((file-name (tabulated-list-get-id)))
+ (belf-rename-desort file-name (file-name-directory file-name))
+ (revert-buffer)))
+
+(defun belf-rename-desort-files (dir new-dir)
+ (interactive)
+ (dolist (file-name
+ (directory-files dir t directory-files-no-dot-files-regexp))
+ (belf-rename-desort file-name new-dir)))
+
+(defun belf-epub-rename-files (dir new-dir)
+ (dolist (epub (directory-files dir t "\\.epub$"))
+ (belf-epub-rename epub new-dir)))
+
+(defun belf-epub-rename (file-name new-dir)
+ (when-let ((content-file-name (belf-epub-content-file-name 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)))
+ (metadata (dom-by-tag dom 'metadata))
+ (title (dom-text (dom-by-tag metadata 'title)))
+ (authors (dom-texts (dom-by-tag metadata 'creator) ", "))
+ (identifier
+ (replace-regexp-in-string
+ "[^0-9,]" ""
+ (dom-texts
+ (seq-filter
+ (lambda (node)
+ (or (equal "ISBN" (dom-attr node 'scheme))
+ (string-match-p "^[0-9]+$" (dom-text node))))
+ (dom-by-tag metadata 'identifier))
+ ",")))
+ (date (replace-regexp-in-string
+ "[^0-9]" ""
+ (dom-text (dom-by-tag metadata 'date))))
+ (year (substring date 0 (min 4 (length date))))
+ (dir (file-name-directory file-name))
+ (new-base-name (belf-format-base-name
+ `((title . ,title)
+ (authors . ,authors)
+ (year . ,year)
+ (identifier . ,identifier))
+ new-dir))
+ new-name)
+ ;; (pp metadata)
+ (dolist (file (directory-files dir t
+ (format "^%s\\.[a-zA-Z0-9]+$"
+ (regexp-quote
+ (file-name-base file-name)))))
+ (setq new-name (format "%s.%s" new-base-name (file-name-extension file)))
+ (unless (equal file-name new-name)
+ (message "%s -> %s" file new-name)
+ (ignore-error 'file-already-exists (rename-file file new-name))
+ )
+ )
+ ))
+ ))
+
+(defun belf-move-invalid-file-names (dir new-dir)
+ "Move files in DIR whose file names do not validate to NEW-DIR."
+ (let (new-name)
+ (dolist (file-name (directory-files dir t directory-files-no-dot-files-regexp))
+ (unless (string-match-p "^.*? +- +.* +([0-9]*) +\\[.*\\]\\.[a-zA-Z0-9]+$" file-name)
+ (message "%s -> %s" file-name
+ (setq new-name (file-name-concat
+ new-dir (file-name-nondirectory file-name))))
+ (rename-file file-name new-name)
+ ))))
+
+(defun belf-epub-rename-at-point ()
+ (interactive)
+ (let ((file-name (tabulated-list-get-id)))
+ (belf-epub-rename file-name (file-name-directory file-name))
+ (revert-buffer)))
+
+(defun belf-parse-file-name (file-name)
+ (let ((fn (file-name-nondirectory file-name)))
+ (when (string-match "^\\(.*?\\) +- +\\(.*\\) +(\\([0-9]*\\)) +\\[\\(.*\\)\\]\\.\\([a-zA-Z0-9]+\\)$" fn)
+ `((authors . ,(match-string 1 fn))
+ (title . ,(match-string 2 fn))
+ (year . ,(match-string 3 fn))
+ (identifier . ,(match-string 4 fn))
+ (ext . ,(match-string 5 fn))))))
+
+(defun belf-format-base-name (info &optional dir)
+ (let-alist info
+ (file-name-concat
+ (expand-file-name (or dir belf-dir))
+ (replace-regexp-in-string
+ "[/:?*\"]" "_"
+ (format "%s - %s (%s) [%s]" .authors .title .year .identifier)))))
+
+(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, .FileSize, .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)
+ (cond ((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)))
+ ((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-set-field ()
+ (interactive)
+ (cond ((equal "Authors"
+ (get-text-property (point) 'tabulated-list-column-name))
+ (call-interactively 'belf-set-authors))))
+
+(defun belf-set-authors (new-authors)
+ (interactive
+ (list
+ (read-string "Set authors to: "
+ (alist-get 'authors (belf-parse-file-name
+ (tabulated-list-get-id))))))
+ (let* ((file-name (tabulated-list-get-id))
+ (parsed (belf-parse-file-name file-name))
+ new-base-name
+ new-file)
+ (setf (alist-get 'authors parsed) new-authors)
+ (setq new-base-name (belf-format-base-name parsed))
+ (dolist (file (directory-files belf-dir t
+ (format "^%s\\.[a-zA-Z0-9]+$"
+ (regexp-quote
+ (file-name-base file-name)))))
+ (setq new-file (format "%s.%s" new-base-name (file-name-extension file)))
+ (message "%s -> %s" file new-file)
+ (rename-file file new-file))
+ (revert-buffer)))
+
+(defun belf-parse-first-author-name (authors)
+ "Returns (last-name . first-name) of the first author of AUTHORS."
+ (when (string-match-p)))
+
+(defun belf-compare-authors (x y)
+ "Authors comparator.
+
+Authors are in the format of
+fname1 lname1, fname2 lname2, ..."
+ (string<
+ (car (last (string-split (car (string-split (elt (cadr x) 0) ", ")) " ")))
+ (car (last (string-split (car (string-split (elt (cadr y) 0) ", ")) " ")))))
+
+(defun belf-compare-title (x y)
+ "Title comparator.
+
+Compare without leading \"The \"."
+ (string<
+ (string-remove-prefix "The " (elt (cadr x) 1))
+ (string-remove-prefix "The " (elt (cadr y) 1))))
+
+(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)
diff --git a/emacs/.emacs.d/lisp/my/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el
index 5698042..0e5e054 100644
--- a/emacs/.emacs.d/lisp/my/infobox.el
+++ b/emacs/.emacs.d/lisp/my/infobox.el
@@ -31,7 +31,11 @@
(cond ((stringp v) v)
((eq v t) "YES")
((eq v :json-false) "NO")
- ((seqp v) (mapconcat #'identity v ", "))
+ ((seqp v)
+ (mapconcat
+ (lambda (x) (if (stringp x) x (prin1-to-string x)))
+ v
+ ", "))
(t (format "%s" v))))
(defun infobox-default-specs (info)
@@ -66,14 +70,19 @@ 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 (file-name-concat
- "/tmp"
- (my-make-filename-from-url thumb-url))))
- (url-copy-file (message 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-width nil t)))
+ :max-width (window-pixel-width)
+ :max-height (/ (window-pixel-height) 2)))
(insert "\n")
- (setq n-rows (1+ n-rows)))
+ (setq n-rows (1+ n-rows))
+ (setq info (assoc-delete-all "Thumbnail" info))
+ )
(seq-do
(lambda (pair)
(when pair
@@ -113,8 +122,8 @@ something like
(end-of-line)
(insert " -- " (buttonize
"xdg-open"
- (lambda (_)
- (call-process "xdg-open" nil 0 nil filename))))
+ (lambda (_) (call-process "xdg-open" nil 0 nil filename)))
+ " " (buttonize "find-file" (lambda (_) (find-file filename))))
(buffer-string))
`(infobox-exiftool ,filename)
(called-interactively-p 'interactive)
diff --git a/emacs/.emacs.d/lisp/my/my-dired.el b/emacs/.emacs.d/lisp/my/my-dired.el
index 83607ab..2fdbfa9 100644
--- a/emacs/.emacs.d/lisp/my/my-dired.el
+++ b/emacs/.emacs.d/lisp/my/my-dired.el
@@ -109,15 +109,24 @@ With a prefix arg, toggle `my-dired-reverse-sorting' instead."
"Empty the xdg trash"
(interactive)
(let* ((xdg-data-dir
- (directory-file-name
- (expand-file-name "Trash"
- (or (getenv "XDG_DATA_HOME")
- "~/.local/share"))))
- (trash-files-dir (expand-file-name "files" xdg-data-dir))
- (trash-info-dir (expand-file-name "info" xdg-data-dir)))
+ (directory-file-name
+ (expand-file-name "Trash"
+ (or (getenv "XDG_DATA_HOME")
+ "~/.local/share"))))
+ (trash-files-dir (expand-file-name "files" xdg-data-dir))
+ (trash-info-dir (expand-file-name "info" xdg-data-dir)))
(delete-directory trash-files-dir t)
(delete-directory trash-info-dir t)))
+(defun my-dired-jump-xdg-trash ()
+ "Open the xdg trash dir in dired."
+ (interactive)
+ (dired
+ (directory-file-name
+ (expand-file-name "Trash"
+ (or (getenv "XDG_DATA_HOME")
+ "~/.local/share")))))
+
(defun my-dired-do-delete (delete-fun &optional arg)
"Wrapper of `dired-do-delete'.
diff --git a/emacs/.emacs.d/lisp/my/my-emms.el b/emacs/.emacs.d/lisp/my/my-emms.el
index e3e4d32..054d3d9 100644
--- a/emacs/.emacs.d/lisp/my/my-emms.el
+++ b/emacs/.emacs.d/lisp/my/my-emms.el
@@ -387,7 +387,7 @@ artist/album/track."
(emms-playlist-current-select-next)
(if (string-equal (my-emms-current-album-name) current-album)
(emms-start)
- (my-emms-playlist-random-album nil))))
+ (my-emms-playlist-random-album))))
(defvar-local my-emms-albums-cache (vector))
@@ -421,12 +421,66 @@ under /zzz-seren/."
(defun my-emms-playlist-random-album ()
(interactive)
(with-current-emms-playlist
- (goto-line (1+ (random (count-lines (point-min) (point-max)))))
- (let ((album-name (my-emms-playlist-album-name-at-point)))
- (goto-char (point-min))
- (search-forward album-name)
- (beginning-of-line)
- (emms-playlist-mode-play-current-track))))
+ (goto-line (1+ (random (count-lines (point-min) (point-max)))))
+ (let ((album-name (my-emms-playlist-album-name-at-point)))
+ (goto-char (point-min))
+ (search-forward album-name)
+ (beginning-of-line)
+ (emms-playlist-mode-play-current-track))))
+
+(defvar my-emms-playlist-group-length 20
+ "Length of a track group in an album.")
+
+(defvar my-emms-playlist-tail-group-length 10
+ "Min length of a tail track group in an album.")
+
+(defun my-emms-playlist-group-bounds ()
+ "Return (GROUP-START . GROUP-END) of the group the current track belongs to."
+ (save-excursion
+ (let* ((album-name (my-emms-playlist-album-name-at-point))
+ (current-ln (line-number-at-pos))
+ (start-ln (progn (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote album-name)))
+ (line-number-at-pos)))
+ (end-ln (progn (goto-char (point-max))
+ (re-search-backward (concat "^" (regexp-quote album-name)))
+ (1+ (line-number-at-pos))))
+ ;; How many tracks have been from the start of the album
+ ;; (exclusive)
+ (past (- current-ln start-ln))
+ ;; How many tracks to go (inclusive)
+ (remain (- end-ln current-ln))
+ (idx (/ past my-emms-playlist-group-length))
+ (maybe-group-start (+ start-ln (* idx my-emms-playlist-group-length)))
+ (group-start
+ (if (< (- end-ln maybe-group-start) my-emms-playlist-tail-group-length)
+ ;; Too close to the end of the album
+ (max start-ln (- maybe-group-start my-emms-playlist-group-length))
+ maybe-group-start))
+ (group-end
+ (if (<= remain my-emms-playlist-tail-group-length)
+ end-ln
+ (min end-ln (+ group-start my-emms-playlist-group-length)))))
+ (cons group-start group-end))))
+
+(defun my-emms-playlist-random-group ()
+ (interactive)
+ (with-current-emms-playlist
+ (goto-line (1+ (random (count-lines (point-min) (point-max)))))
+ (pcase-let ((`(,group-start . ,group-end) (my-emms-playlist-group-bounds)))
+ (goto-line group-start)
+ (emms-playlist-mode-play-current-track))))
+
+(defun my-emms-next-track-or-random-group ()
+ (interactive)
+ (with-current-buffer emms-playlist-buffer
+ (emms-playlist-mode-center-current)
+ (pcase-let ((`(,group-start . ,group-end) (my-emms-playlist-group-bounds)))
+ (when emms-player-playing-p (emms-stop))
+ (if (>= (1+ (line-number-at-pos)) group-end)
+ (my-emms-playlist-random-group)
+ (emms-playlist-current-select-next)
+ (emms-start)))))
;;; override the minor mode
;;;###autoload
diff --git a/emacs/.emacs.d/lisp/my/my-github.el b/emacs/.emacs.d/lisp/my/my-github.el
index 7caff57..e2d5f6a 100644
--- a/emacs/.emacs.d/lisp/my/my-github.el
+++ b/emacs/.emacs.d/lisp/my/my-github.el
@@ -25,7 +25,7 @@
;; Github client.
;;; Code:
-
+(require 'my-web)
(defun my-grok-github (url)
"get github info of a project.
@@ -93,7 +93,7 @@ License; name; description; homepage; created at"
)
(defvar my-github-project-info-specs
- `((html_url . "Clone")
+ `((html_url . ("URL" . my-forge-infobox-format-url))
(full_name . "Name")
(description . "Description")
(created_at . ("Created at" . my-gitlab-format-time-string))
diff --git a/emacs/.emacs.d/lisp/my/my-gitlab.el b/emacs/.emacs.d/lisp/my/my-gitlab.el
index 27f3344..56542c0 100644
--- a/emacs/.emacs.d/lisp/my/my-gitlab.el
+++ b/emacs/.emacs.d/lisp/my/my-gitlab.el
@@ -75,17 +75,9 @@
(require 'my-buffer)
(require 'my-web)
(require 'my-magit)
-(defun my-gitlab-format-url (url)
- (concat url
- " -- " (buttonize "clone"
- (lambda (_)
- (my-magit-clone url current-prefix-arg)))
- " " (buttonize "context"
- (lambda (_)
- (funcall my-url-context-function url)))))
(defvar my-gitlab-project-info-specs
- `((http_url_to_repo . ("URL" . my-gitlab-format-url))
+ `((http_url_to_repo . ("URL" . my-forge-infobox-format-url))
(name_with_namespace . "Name")
(description . "Description")
(created_at . ("Created at" . my-gitlab-format-time-string))
diff --git a/emacs/.emacs.d/lisp/my/my-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el
index 14dff82..6a2142b 100644
--- a/emacs/.emacs.d/lisp/my/my-gnus.el
+++ b/emacs/.emacs.d/lisp/my/my-gnus.el
@@ -162,7 +162,7 @@ The archiving target comes from `my-gnus-group-alist'."
"The default inbox to be opened with `my-gnus-open-inbox'.")
(defun my-gnus-open-inbox ()
(interactive)
- (gnus-group-read-group t t my-gnus-inbox-group))
+ (gnus-group-read-group 200 t my-gnus-inbox-group))
(defun my-gnus-start ()
(interactive)
diff --git a/emacs/.emacs.d/lisp/my/my-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el
index 67e0071..9d3a9db 100644
--- a/emacs/.emacs.d/lisp/my/my-libgen.el
+++ b/emacs/.emacs.d/lisp/my/my-libgen.el
@@ -42,6 +42,8 @@
(defvar my-libgen-host nil)
(defvar my-libgen-library-host nil)
+(defvar my-libgen-plus-host nil)
+
(defun my-libgen-set-random-hosts ()
"Randomly set `my-libgen-host' and `my-libgen-library-host'"
(setq my-libgen-library-host
@@ -134,7 +136,7 @@
(alist-get 'coverurl info)))))
(defun my-libgen-format-filename (info)
- (replace-regexp-in-string "[:;]" "_"
+ (replace-regexp-in-string "[:;?]" "_"
(format
"%s - %s (%s) [%s].%s"
(alist-get 'author info)
@@ -160,7 +162,35 @@
id-head
(downcase (alist-get 'md5 info)))))
-(defun my-libgen-download-action ()
+(defun my-libgen-plus-get-download-url (info)
+ (let-alist info
+ (file-name-concat
+ my-libgen-plus-host
+ (dom-attr
+ (dom-search
+ (my-url-fetch-dom (format "%s/ads.php?md5=%s" my-libgen-plus-host .md5))
+ (lambda (n)
+ (string-match (format "get\\.php\\?md5=%s" .md5)
+ (or (dom-attr n 'href) ""))))
+ 'href))))
+
+(defun my-libgen-plus-download-action ()
+ (interactive)
+ (let ((info (get-text-property (point) 'button-data)))
+ (my-wget-async
+ (my-libgen-plus-get-download-url info)
+ (file-name-concat (expand-file-name my-libgen-download-dir)
+ (my-libgen-format-filename info)))))
+
+(defun my-libgen-download-library-action ()
+ (interactive)
+ (let ((info (get-text-property (point) 'button-data)))
+ (my-wget-async
+ (my-libgen-make-download-link-library info)
+ (format "%s/%s" (expand-file-name my-libgen-download-dir)
+ (my-libgen-format-filename info)))))
+
+(defun my-libgen-download-onion-action ()
(interactive)
(let ((info (get-text-property (point) 'button-data)))
(my-wget-async
@@ -171,18 +201,27 @@
(defvar my-libgen-button-keymap
(let ((kmap (make-sparse-keymap)))
(set-keymap-parent kmap button-map)
- (define-key kmap "d" 'my-libgen-download-action)
+ (define-key kmap "d" 'my-libgen-download-library-action)
+ (define-key kmap "t" 'my-libgen-download-onion-action)
(define-key kmap "p" 'my-libgen-show-more-info)
kmap))
+(defvar my-libgen-plus-button-keymap
+ (let ((kmap (make-sparse-keymap)))
+ (set-keymap-parent kmap button-map)
+ (define-key kmap "d" 'my-libgen-plus-download-action)
+ ;; (define-key kmap "t" 'my-libgen-download-onion-action)
+ ;; (define-key kmap "p" 'my-libgen-show-more-info)
+ kmap))
+
(defun my-libgen-show-more-info ()
(interactive)
(pp (my-grok-libgen-make-info
- (elt
- (my-libgen-api-by-id
- (alist-get 'id
- (get-text-property (point) 'button-data)))
- 0))))
+ (elt
+ (my-libgen-api-by-id
+ (alist-get 'id
+ (get-text-property (point) 'button-data)))
+ 0))))
(defun my-libgen-search-isbn (isbn)
(interactive "sISBN: ")
@@ -208,6 +247,34 @@
(default-action . my-grok-libgen-action)
(keymap . ,my-libgen-button-keymap))))
+(defun my-libgen-plus-search (query)
+ (interactive "sQuery: ")
+ (let* ((dom
+ (my-url-fetch-dom
+ (format "%s/index.php?req=%s&topics[]=l&topics[]=c&topics[]=f"
+ my-libgen-plus-host query)))
+ (rows
+ (dom-by-tag
+ (dom-by-tag
+ (dom-by-id (dom-by-tag dom 'body) "tablelibgen") 'tbody)
+ 'tr)
+ ))
+ (generic-search-open
+ (seq-map 'my-libgen-plus-search-parse-tr rows)
+ (format "libgen-plus-query:%s" query)
+ `((formatter . my-libgen-plus-search-format-result)
+ (keymap . ,my-libgen-plus-button-keymap))))
+ )
+
+(defun my-libgen-plus-search-format-result (info)
+ (format
+ "%s [%spp,%s,%s] %s"
+ (my-libgen-format-filename info)
+ (alist-get 'pages info)
+ (alist-get 'publisher info)
+ (alist-get 'language info)
+ (alist-get 'filesize-human info)))
+
(defun my-libgen-search-format-result (info)
(format
"%s [%s,%spp,%s,%s] %s"
@@ -218,6 +285,65 @@
(alist-get 'language info)
(alist-get 'filesize-human info)))
+(defun my-libgen-plus-parse-title-id (dom)
+ (let ((as
+ (dom-by-tag dom 'a))
+ (title "")
+ identifier
+ edition-id)
+ (while (and as (string-empty-p title))
+ (setq title (string-trim (dom-texts (car as) ""))
+ edition-id (string-remove-prefix
+ "edition.php?id="
+ (dom-attr (car as) 'href))
+ as (cdr as)))
+ (when (string-empty-p title)
+ (error "Title is empty: %s" dom))
+ (when as
+ (setq identifier
+ (replace-regexp-in-string
+ "; " ","
+ (string-trim (dom-texts (dom-by-tag (car as) 'i))))))
+ `((title . ,title)
+ (edition-id . ,edition-id)
+ (identifier . ,identifier))))
+
+(defun my-libgen-plus-search-parse-tr (tr)
+ (let* ((tds (dom-by-tag tr 'td))
+ (title-id (my-libgen-plus-parse-title-id (elt tds 0)))
+ (title (alist-get 'title title-id))
+ ;; file-id
+ (edition-id (alist-get 'edition-id title-id))
+ (identifier (alist-get 'identifier title-id))
+ (author (string-trim (dom-text (elt tds 1))))
+ (publisher (dom-text (elt tds 2)))
+ (year (dom-texts (elt tds 3)))
+ (language (dom-text (elt tds 4)))
+ (pages (dom-text (elt tds 5)))
+ (size-id (car (dom-by-tag (elt tds 6) 'a)))
+ (filesize-human (dom-text size-id))
+ (file-id (string-remove-prefix "/file.php?id="
+ (dom-attr size-id 'href)))
+ (extension (dom-text (elt tds 7)))
+ (mirrors-td (elt tds 8))
+ (mirrors (seq-map (lambda (mirror) (dom-attr mirror 'href))
+ (dom-by-tag mirrors-td 'a)))
+ (md5 (substring (car mirrors) 4 36))
+ )
+ `((title . ,title)
+ (identifier . ,identifier)
+ (edition-id . ,edition-id)
+ (author . ,author)
+ (publisher . ,publisher)
+ (language . ,language)
+ (year . ,year)
+ (pages . ,pages)
+ (filesize-human . ,filesize-human)
+ (file-id . ,file-id)
+ (extension . ,extension)
+ (mirrors . ,mirrors)
+ (md5 . ,md5))))
+
(defun my-libgen-search-parse-tr (tr)
(let* ((tds (dom-by-tag tr 'td))
(id (dom-text (pop tds)))
diff --git a/emacs/.emacs.d/lisp/my/my-nov.el b/emacs/.emacs.d/lisp/my/my-nov.el
index 1bc8eca..816afc6 100644
--- a/emacs/.emacs.d/lisp/my/my-nov.el
+++ b/emacs/.emacs.d/lisp/my/my-nov.el
@@ -65,8 +65,16 @@ chapter title."
nov-file-name dest staging)))
(defun my-nov-set-margins ()
- (set-window-margins nil 3 2)
- (set-window-fringes nil 0 0))
+ ;; Does not work as well as setq left- and right-margin-width
+ ;; (set-window-margins nil 3 2)
+ (setq left-margin-width 3)
+ (setq right-margin-width 2)
+ ;; Does not work as well as setq left- and right-fringe-width
+ ;; (set-window-fringes nil 0 0)
+ (setq left-fringe-width 0)
+ (setq right-fringe-width 0)
+ (visual-line-mode)
+ )
(provide 'my-nov)
;;; my-nov.el ends here
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el
index 3d1f9d3..7d08936 100644
--- a/emacs/.emacs.d/lisp/my/my-web.el
+++ b/emacs/.emacs.d/lisp/my/my-web.el
@@ -215,13 +215,41 @@ https://emacs.stackexchange.com/questions/40887/in-org-mode-how-do-i-link-to-int
(with-temp-buffer
(call-process "sqlite3" nil t nil
(format "file://%s/places.sqlite?immutable=1"
- my-firefox-profile-dir)
+ (expand-file-name my-firefox-profile-dir))
(format
"SELECT url,title FROM moz_places %s ORDER BY visit_count desc limit %d"
where
my-firefox-place-limit))
- (buffer-string)
+ (string-lines (buffer-string))
)))
+(defun my-firefox-places-collection (query pred action)
+ (if (eq action 'metadata)
+ `(metadata (display-sort-function . ,#'identity)
+ ;; Needed for icomplete to respect list order
+ (cycle-sort-function . ,#'identity))
+ (let ((candidates (my-firefox-places query)))
+ (message "Got %d candidates for query %s. Current action is %s" (length candidates) query action)
+ (cl-loop for str in-ref candidates do
+ (setf str (orderless--highlight regexps ignore-case (substring str))))
+ candidates
+ ;; Does not show remotely as many results
+ ;; (complete-with-action action candidates query pred)
+ )))
+
+(defun my-browse-url (url)
+ (interactive (list (completing-read "URL to browse: "
+ #'my-firefox-places-collection)))
+ (message url))
+
+(defun my-forge-infobox-format-url (url)
+ (concat url
+ " -- " (buttonize "clone"
+ (lambda (_)
+ (my-magit-clone url current-prefix-arg)))
+ " " (buttonize "context"
+ (lambda (_)
+ (funcall my-url-context-function url)))))
+
(provide 'my-web)
;;; my-web.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 09:25:38 +0000