diff options
Diffstat (limited to 'emacs/.emacs.d/lisp/my')
24 files changed, 1649 insertions, 184 deletions
diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el index 35175be..df9b53b 100644 --- a/emacs/.emacs.d/lisp/my/belf.el +++ b/emacs/.emacs.d/lisp/my/belf.el @@ -28,6 +28,7 @@ (require 'tabulated-list) (require 'infobox) +(require 'my-epub) (defvar-keymap belf-mode-map :parent tabulated-list-mode-map @@ -76,7 +77,7 @@ (defvar belf-dir "~/Documents" "Directory of books.") -(defun belf-parse-all-file-names () +(defun belf-parse-file-names (file-names) (seq-filter #'identity (seq-map @@ -84,7 +85,10 @@ (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\\)$")))) + file-names))) + +(defun belf-parse-all-file-names () + (belf-parse-file-names (directory-files belf-dir t "\\.\\(epub\\|pdf\\|cbr\\|djvu\\|mobi\\|azw3\\)$"))) (defun belf-file-name-desort (file-name new-dir) "Rename a file. @@ -147,47 +151,21 @@ foo bar & quux, baf" (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)) - ) + (when-let ((meta (my-epub-metadata file-name))) + (let* ((dir (file-name-directory file-name)) + (new-base-name (belf-format-base-name meta new-dir)) + new-name) + (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) @@ -201,6 +179,14 @@ foo bar & quux, baf" (rename-file file-name new-name) )))) +(defun belf-dired-do-epub-rename () + (interactive) + (seq-do + (lambda (file) + (when (equal (upcase (file-name-extension file)) "EPUB") + (belf-epub-rename file (file-name-directory file)))) + (dired-get-marked-files))) + (defun belf-epub-rename-at-point () (interactive) (let ((file-name (tabulated-list-get-id))) @@ -242,15 +228,6 @@ foo bar & quux, baf" (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) @@ -326,7 +303,7 @@ 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)) + (when-let* ((content-file-name (my-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 @@ -352,12 +329,13 @@ For EPUB, looks for a cover image in the file." (alist-get 'authors (belf-parse-file-name (tabulated-list-get-id)))))) (let* ((file-name (tabulated-list-get-id)) + (dir (file-name-directory file-name)) (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 + (setq new-base-name (belf-format-base-name parsed dir)) + (dolist (file (directory-files dir t (format "^%s\\.[a-zA-Z0-9]+$" (regexp-quote (file-name-base file-name))))) @@ -448,4 +426,111 @@ Compare without leading \"The \"." (interactive) (find-file-other-window (tabulated-list-get-id))) +;;; belf-recent + +(defvar belf-recent-file (locate-user-emacs-file "belf-list")) + +(defun belf-recent-add (file) + "Add FILE to `belf-recent-file'. + +Can be used as a `find-file-hook'." + (when (string-match-p "\\.\\(epub\\|pdf\\|cbr\\|djvu\\|mobi\\|azw3\\)$" + file) + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (flush-lines (rx-to-string `(and bol "[" (= 23 anychar) "] " ,file eol))) + (insert + (format-time-string "[%Y-%m-%d %a %H:%M:%S]" (current-time)) + " " + file + "\n") + (write-file belf-recent-file) + ))) + +(defun belf-recent-add-current () + (when buffer-file-name + (belf-recent-add buffer-file-name))) + +(define-derived-mode belf-recent-mode belf-mode "Bookshelf Recent" + "Major mode for browsing a list of books." + (setq revert-buffer-function #'belf-recent-list-refresh-contents)) + +(defun belf-recent () + (interactive) + (let ((buf (get-buffer-create "*Bookshelf Recent*"))) + (with-current-buffer buf + (belf-recent-mode) + (belf-recent-list-refresh-contents)) + (pop-to-buffer-same-window buf))) + +;; (defvar belf-find-dir nil +;; "Directory to run find command for relocated files.") + +(defvar belf-locate-dirs nil + "Directories to look for relocated files.") + +(defun belf-recent-bookkeeping () + "Check `belf-recent-file' for (re)moved files and update accordingly." + (interactive) + (copy-file belf-recent-file (concat belf-recent-file ".bak") t) + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 26) + (let* ((beg (point)) + (end (progn (end-of-line) (point))) + (file-name (buffer-substring-no-properties beg end))) + (unless (file-exists-p file-name) + (let ((dirs belf-locate-dirs) + (file-name-nodir (file-name-nondirectory file-name)) + dir new-name found) + (delete-region beg end) + (while (and (not found) dirs) + (setq dir (expand-file-name (car dirs)) + new-name (file-name-concat dir file-name-nodir) + found (file-exists-p new-name) + dirs (cdr dirs))) + (when found (insert new-name))) + ;; Running find on a big dir is too slow even when there are + ;; only a few thousands subdirs + ;; (call-process "find" nil (current-buffer) nil + ;; (expand-file-name belf-find-dir) + ;; "-name" (file-name-nondirectory file-name)) + ) + (beginning-of-line 2))) + + ;; Remove empty records that could not be found + (goto-char (point-min)) + (flush-lines (rx bol (= 26 anychar) eol)) + + ;; Deduplicate + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 26) + (let* ((beg (point)) + (end (progn (end-of-line) (point))) + (file-name (buffer-substring-no-properties beg end))) + (flush-lines + (rx-to-string `(and bol "[" (= 23 anychar) "] " ,file-name eol)))) + (beginning-of-line 2)) + (write-file belf-recent-file))) + +(defun belf-recent-list-refresh-contents (&rest _) + (belf-recent-bookkeeping) + (setq-local tabulated-list-entries (belf-recent-parse-file-names)) + (tabulated-list-print)) + +(defun belf-recent-parse-file-names () + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (replace-regexp (rx bol (= 26 anychar)) "") + (belf-parse-file-names (string-lines (buffer-string)))) + ) + (provide 'belf) diff --git a/emacs/.emacs.d/lisp/my/emms-info-ytdl.el b/emacs/.emacs.d/lisp/my/emms-info-ytdl.el index 489f3fb..0c7a1d2 100644 --- a/emacs/.emacs.d/lisp/my/emms-info-ytdl.el +++ b/emacs/.emacs.d/lisp/my/emms-info-ytdl.el @@ -31,7 +31,7 @@ (require 'emms-info) (require 'json) - +(require 'tor) (defgroup emms-info-ytdl nil "Options for EMMS." @@ -70,12 +70,10 @@ (with-temp-buffer (when (zerop (let ((coding-system-for-read 'utf-8)) - (if emms-info-ytdl-using-torsocks - (my-call-process-with-torsocks - emms-info-ytdl-command nil '(t nil) nil "-j" - (emms-track-name track)) - (call-process emms-info-ytdl-command nil '(t nil) nil - "-j" (emms-track-name track))))) + (my-call-process-with-torsocks + (not emms-info-ytdl-using-torsocks) + emms-info-ytdl-command nil '(t nil) nil "-j" + (emms-track-name track)))) (goto-char (point-min)) (condition-case nil (let ((json-fields (json-read))) diff --git a/emacs/.emacs.d/lisp/my/fediorg.el b/emacs/.emacs.d/lisp/my/fediorg.el index e2f21b8..744206e 100644 --- a/emacs/.emacs.d/lisp/my/fediorg.el +++ b/emacs/.emacs.d/lisp/my/fediorg.el @@ -233,11 +233,14 @@ Including ancestors and descendants, if any." attachments "\n")) -(defun fediorg-format-post (post level) - "Format a POST with indent LEVEL." +(defun fediorg-format-post (post level &optional absolute-time) + "Format a POST with indent LEVEL. + +Required fields: url, created_at, account.username +Optional fields: account.display_name" (let-alist post (let ((host (car (fediorg-parse-url .url)))) - (format "%s %s (@%s@%s) %s\n\n%s%s\n\n⤷%d ⇆%d ★%d\n" + (format "%s %s (@%s@%s) %s\n\n%s%s\n\n⤷%s ⇆%s ★%s\n" (make-string level ?*) (if (string-empty-p .account.display_name) .account.username .account.display_name) @@ -245,10 +248,12 @@ Including ancestors and descendants, if any." host (fediorg-make-org-link .url - (fediorg--relative-time-description .created_at)) + (if absolute-time .created_at + (fediorg--relative-time-description .created_at))) (with-temp-buffer (insert .content) - (shr-render-region (point-min) (point-max)) + (let ((shr-fill-text nil)) + (shr-render-region (point-min) (point-max))) (buffer-substring-no-properties (point-min) (point-max))) (fediorg-format-attached .media_attachments host) .replies_count @@ -275,6 +280,78 @@ Including ancestors and descendants, if any." (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url))) (format "%s.%s.org" host post-id))) +(defun fediorg-archive-make-file-name (actor) + (let-alist (fediorg-archive-parse-actor actor) + (format "%s.%s.org" .host .username))) + +(defun fediorg-archive-parse-actor (actor) + "Parse actor to username and display_name." + (let ((username (alist-get 'preferredUsername actor)) + (name (alist-get 'name actor)) + (url (alist-get 'id actor))) + (pcase-let* ((urlobj (url-generic-parse-url url)) + (host (url-host urlobj))) + `((display_name . ,name) + (username . ,username) + (host . ,host)))) + ) + +(defun fediorg-archive-format-item (item actor) + "ACTOR is parsed actor.json." + (let (post) + (pcase (alist-get 'type item) + ("Create" + (setq post (alist-get 'object item)) + (setf (alist-get 'url post) (alist-get 'id post) + (alist-get 'created_at post) (alist-get 'published item) + (alist-get 'account post) actor + (alist-get 'replies_count post) (alist-get 'repliesCount post))) + ("Announce" + (setf (alist-get 'url post) (alist-get 'object item) + (alist-get 'created_at post) (alist-get 'published item) + (alist-get 'account post) actor + (alist-get 'content post) + (format "[repost of %s]" (alist-get 'object item))))) + (fediorg-format-post post 1 t))) + +(defun fediorg-archive-format-outbox (info actor) + "Transform an outbox.json and an actor.json to an org file." + (let ((parsed-actor (fediorg-archive-parse-actor actor))) + (string-join + (seq-map + (lambda (item) (fediorg-archive-format-item item parsed-actor)) + (alist-get 'orderedItems info)) + "\n"))) + +;;;###autoload +(defun fediorg-archive-open (dir) + "Given a fedi archive, open an org buffer showing all outbox posts. + +A fedi archive can be obtained by exporting. This function requires an +outbox.json and an actor.json file. + +TODO: +- add support for likes and bookmarks +- add support for inline announces +- add inline images +- mark dm +" + (interactive (list (read-directory-name "Fedi archive dir: "))) + (let ((outbox-file (file-name-concat dir "outbox.json")) + (actor-file (file-name-concat dir "actor.json")) + (outbox) (actor)) + (unless (and (file-exists-p actor-file) (file-exists-p outbox-file)) + (error "Actor or outbox file missing!")) + (with-temp-buffer + (insert-file-contents actor-file) + (setq actor (json-read))) + (with-temp-buffer + (insert-file-contents outbox-file) + (setq outbox (json-read))) + (fediorg-save-text-and-switch-to-buffer + (fediorg-archive-format-outbox outbox actor) + (file-name-concat dir (fediorg-archive-make-file-name actor))))) + ;;;###autoload (defun fediorg-open (url) "Given a fedi post URL, open an org buffer rendering the post. diff --git a/emacs/.emacs.d/lisp/my/iarc.el b/emacs/.emacs.d/lisp/my/iarc.el new file mode 100644 index 0000000..d29d525 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/iarc.el @@ -0,0 +1,159 @@ +;;; iarc.el -- internet archive client -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "30.1")) + +;; 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: + +;; internet archive client. + +;;; Code: + +(require 'infobox) + +(defvar-keymap iarc-mode-map + :parent tabulated-list-mode-map + "F" #'iarc-toggle-follow-mode + "i" #'iarc-infobox + "n" #'iarc-next-line + "p" #'iarc-previous-line + "RET" #'iarc-item-at-point + ) + +(define-derived-mode iarc-mode tabulated-list-mode "IArc" + (hl-line-mode 1) + (setq tabulated-list-format + [("★ " 3 iarc-compare-favourites :right-align t) + ("Title" 60 t)]) + (setq tabulated-list-padding 2) + (tabulated-list-init-header) + (setq revert-buffer-function #'iarc-list-refresh)) + +(defvar iarc-search-dataset nil) + +(defvar iarc-follow-mode nil "Whether follow mode is on.") + +(defun iarc-toggle-follow-mode () + (interactive) + (setq iarc-follow-mode (not iarc-follow-mode))) + +(defun iarc-previous-line () + (interactive) + (previous-line) + (when iarc-follow-mode + (iarc-infobox))) + +(defun iarc-next-line () + (interactive) + (next-line) + (when iarc-follow-mode + (iarc-infobox))) + +(defun iarc-compare-favourites (x y) + (> (let-alist (car x) (or .fields.num_favorites 0)) + (let-alist (car y) (or .fields.num_favorites 0)))) + +(defun iarc-list-print-entry (info) + (let-alist (alist-get 'fields info) + (list info (vector (format "%d" (or .num_favorites 0)) + .title)))) + +(defun iarc-list-refresh (&rest _) + (interactive) + (setq tabulated-list-entries + (seq-map 'iarc-list-print-entry iarc-search-dataset)) + (tabulated-list-print)) + +(defun iarc () + (let ((buf (get-buffer-create "*IArc*"))) + (with-current-buffer buf + (iarc-mode) + (iarc-list-refresh)) + (pop-to-buffer-same-window buf))) + +(defvar iarc-host "https://archive.org") + +(defun iarc-api-search (query) + (my-url-fetch-json + (format "%s/services/search/beta/page_production/?user_query=title:(%s)&hits_per_page=100&page=1&aggregations=false" + iarc-host query))) + +(defun iarc-search (query) + (interactive "sIArc Query: ") + (setq iarc-search-dataset (let-alist (iarc-api-search query) + .response.body.hits.hits)) + (iarc)) + +(defun iarc-infobox () + (interactive) + (let ((help-window-select (not iarc-follow-mode))) + (iarc-render-info (alist-get 'fields (tabulated-list-get-id))))) + +(defun iarc-render-info (info) + (infobox-render + (infobox-translate info (infobox-default-specs info)) + `(iarc-render-infobox ,info) + (called-interactively-p 'interactive))) + +(defun iarc-item-at-point () + (interactive) + (iarc-item (alist-get 'identifier (alist-get 'fields + (tabulated-list-get-id))))) + +(define-derived-mode iarc-item-mode tabulated-list-mode "IArc Item" + (hl-line-mode 1) + (setq revert-buffer-function #'iarc-list-refresh)) + +(defvar-local iarc-item-id nil "The item identifier for the iarc-item mode") +(defvar-local iarc-item-data nil "The content of the iarc-item mode") + +(defun iarc-item (id) + "List content of item with ID" + (let* ((buf (get-buffer-create (format "*IArc %s*" id))) + (out + (seq-map + (lambda (s) (split-string s "\t")) + (string-lines + (with-temp-buffer + (call-process "ia" nil t nil "ls" "-v" "-c" "name,mtime,size" id) + (buffer-string)))))) + (with-current-buffer buf + (setq tabulated-list-format + (vconcat + (seq-map + (lambda (c) (list c 20)) + (car out)))) + (setq tabulated-list-padding 2) + (iarc-item-mode) + (tabulated-list-init-header) + (setq iarc-item-data (cdr out)) + (iarc-item-list-refresh)) + (pop-to-buffer-same-window buf))) + +(defun iarc-item-list-refresh () + (setq tabulated-list-entries + (seq-map 'iarc-item-list-print-entry iarc-item-data)) + (tabulated-list-print)) + +(defun iarc-item-list-print-entry (info) + (list info (vconcat info))) + +(provide 'iarc) +;;; iarc.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-buffer.el b/emacs/.emacs.d/lisp/my/my-buffer.el index a8683de..1c93abc 100644 --- a/emacs/.emacs.d/lisp/my/my-buffer.el +++ b/emacs/.emacs.d/lisp/my/my-buffer.el @@ -526,5 +526,9 @@ With double prefix arguments, create a new indirect buffer." (with-no-warnings (font-lock-fontify-buffer))) (buffer-string))) +;;; Disable follow mode +(defun my-follow-mode (&rest _) + (error "follow-mode is disabled.")) + (provide 'my-buffer) ;;; my-buffer.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-editing.el b/emacs/.emacs.d/lisp/my/my-editing.el index 0775063..8ce68dd 100644 --- a/emacs/.emacs.d/lisp/my/my-editing.el +++ b/emacs/.emacs.d/lisp/my/my-editing.el @@ -189,7 +189,10 @@ by passing optional prefix ARG (\\[universal-argument])." (beginning-of-line) (newline) (forward-line -1) - (indent-according-to-mode)) + ;; `indent-according-to-mode' causes cursor to jump to the + ;; beginning of an org src block + (unless (and (derived-mode-p 'org-mode) (org-in-src-block-p)) + (indent-according-to-mode))) (forward-line -1) (my-new-line-below)))) @@ -528,7 +531,7 @@ With an prefix-arg, copy the file name relative to project root." (interactive) (let ((old-max (point-max)) (old-point (point))) - (comment-kill (or n 1)) + (when comment-start (comment-kill (or n 1))) (when (= old-max (point-max)) (goto-char old-point) (kill-sexp n)))) @@ -546,11 +549,32 @@ With an prefix-arg, copy the file name relative to project root." (defun my-elide-region (b e) (interactive "r") - (let ((message-elide-ellipsis (concat comment-start - " [... %l lines elided] -"))) + (let ((message-elide-ellipsis + (if (> (count-lines b (min (1+ e) (point-max))) 1) + (concat comment-start + " [... %l lines elided] +") + (format " [... %d words elided]" (count-words b e))))) (message-elide-region b e))) +(defun my-elide-text (text limit) + "Elide TEXT to about LIMIT characters." + (let ((keep (- limit 25))) + (when (< keep 0) + (error "Too few characters to limit to. Should be at least 25.")) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (and (<= (point) keep) (< (point) (point-max))) + (forward-word)) + (cond ((> (point) keep) + (backward-word) + (my-elide-region (point) (point-max)) + (buffer-string)) + (t text)) + )) + ) + (defun my-replace-no-filter (old-fun &rest r) (let ((search-invisible t)) (apply old-fun r))) diff --git a/emacs/.emacs.d/lisp/my/my-emms.el b/emacs/.emacs.d/lisp/my/my-emms.el index e77089d..0a42efe 100644 --- a/emacs/.emacs.d/lisp/my/my-emms.el +++ b/emacs/.emacs.d/lisp/my/my-emms.el @@ -257,8 +257,7 @@ filter extensions from filter-exts." (not (equal s "")) (or (not filter-exts) (member - (when (string-match "^.*\\.\\(.*\\)$" s) - (match-string 1 s)) + (downcase (or (file-name-extension s) "")) filter-exts)))) (split-string (buffer-substring-no-properties from to) " @@ -464,26 +463,88 @@ under /zzz-seren/." (min end-ln maybe-group-end)))) (cons group-start group-end)))) +(defvar-local my-emms-playlist-group-start-overlay nil) +(defvar-local my-emms-playlist-group-end-overlay nil) + +(defun my-emms-playlist-mark-bounds (group-end) + "Mark bounds of the current track group. + +An up arrow at the first played in the current group, and a down +arrow at the end of the track group." + (when my-emms-playlist-group-start-overlay + (delete-overlay my-emms-playlist-group-start-overlay)) + (when my-emms-playlist-group-start-overlay + (delete-overlay my-emms-playlist-group-end-overlay)) + (setq my-emms-playlist-group-start-overlay (make-overlay (point) (point))) + (overlay-put + my-emms-playlist-group-start-overlay + 'before-string (propertize + "x" 'display + `(left-fringe up-arrow emms-playlist-selected-face))) + (save-excursion + (goto-line (1- group-end)) + (setq my-emms-playlist-group-end-overlay (make-overlay (point) (point))) + (overlay-put + my-emms-playlist-group-end-overlay + 'before-string (propertize + "x" 'display + `(left-fringe down-arrow emms-playlist-selected-face))))) + +(defun my-emms-mode-line-playlist-current () + "Format the currently playing song. + +Override `emms-mode-line-playlist-current' to incorporate wide chars." + (let ((track-desc (my-emms-get-display-name-1 + (emms-track-description + (emms-playlist-current-selected-track))))) + (format emms-mode-line-format + (if (< (string-width track-desc) emms-mode-line-length-limit) + track-desc + (concat + (seq-subseq + track-desc 0 + (- (length track-desc) + (- (string-width track-desc) emms-mode-line-length-limit))) + "..."))))) + + +;; (defun my-emms-playing-time-mode-line () +;; "Add playing time to the mode line. + +;; Override `emms-playing-time-mode-line': prepend instead of append." +;; (or global-mode-string (setq global-mode-string '(""))) +;; (unless (member 'emms-playing-time-string +;; global-mode-string) +;; (setq global-mode-string +;; (append '(emms-playing-time-string) global-mode-string)))) + + (defun my-emms-playlist-random-group () (interactive) (with-current-emms-playlist - (remove-overlays) - (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) - (overlay-put - (make-overlay (point) (point)) - 'before-string (propertize - "x" 'display - `(left-fringe down-arrow emms-playlist-selected-face))) - (save-excursion - (goto-line (1- group-end)) - (overlay-put - (make-overlay (point) (point)) - 'before-string (propertize - "x" 'display - `(left-fringe up-arrow emms-playlist-selected-face)))) - (emms-playlist-mode-play-current-track)))) + (let ((random-line (1+ (random (count-lines (point-min) (point-max)))))) + (goto-line random-line) + (pcase-let ((`(,group-start . ,group-end) (my-emms-playlist-group-bounds))) + (message "my-emms-playlist-random-group: (%d, %d)" random-line group-start) + (goto-line group-start) + (my-emms-playlist-mark-bounds group-end) + (emms-playlist-mode-play-current-track))))) + +;;; TODO: mark bounds if and only if the currently played is out of +;;; the existing overlay. +(defun my-emms-playlist-maybe-mark-bounds () + "Used as an `emms-player-started-hook'. + +If the last command is `emms-playlist-mode-play-smart' i.e. the +user manually chose the track to play, and if +`emms-player-next-function' is +`my-emms-next-track-or-random-group', then mark boundaries since +it would not have been marked otherwise." + (when (and (eq last-command 'emms-playlist-mode-play-smart) + (eq emms-player-next-function 'my-emms-next-track-or-random-group)) + (with-current-emms-playlist + (pcase-let ((`(_ . ,group-end) (my-emms-playlist-group-bounds))) + (my-emms-playlist-mark-bounds group-end))))) (defun my-emms-next-track-or-random-group () (interactive) @@ -563,12 +624,22 @@ character." (defvar my-emms-score-delta 1) (defun my-emms-score-up-playing () - "Increase score by `my-emms-score-delta', then reset it to 1." + "Increase score by `my-emms-score-delta', then reset the score delta to 1." (emms-score-change-score my-emms-score-delta (my-emms-get-display-name-1 (emms-score-current-selected-track-filename))) (setq my-emms-score-delta 1)) +(defun my-emms-score-show-playing () + "Show score for current playing track in minibuf. + +Override `emms-score-show-playing' - using last three components in the name..." + (interactive) + (message "track/tolerance score: %d/%d" + (emms-score-get-score (my-emms-get-display-name-1 + (emms-score-current-selected-track-filename))) + emms-score-min-score)) + (defun my-emms-score-up-chosen-bonus () "Bonus score up if the track is started intentionally. @@ -581,14 +652,40 @@ If the last command is `emms-playlist-mode-play-smart', then set ) (defun my-emms-wrapped () - "Print top 5 scored tracks." + "Print top 10 scored tracks." (interactive) (let (keys) (maphash (lambda (k _) (push k keys)) emms-score-hash) (sort keys (lambda (k1 k2) (> (cl-second (gethash k1 emms-score-hash)) (cl-second (gethash k2 emms-score-hash))))) - (message "Top 5: %s" (string-join (take 5 keys) "\n")))) + (message "Top 10: %s" (string-join (take 10 keys) "\n")))) + +(defun my-emms-maybe-get-duration-for-current-track () + "Get duration for the current track. + +Can be used as a `emms-player-started-hook'" + (unless (emms-track-get (emms-playlist-current-selected-track) + 'info-playing-time) + (my-emms-info-ffprobe (emms-playlist-current-selected-track)))) + +(defun my-emms-info-ffprobe (track) + "Use ffprobe for urls to get duration. + +Call + +ffprobe -v error -show_entries format=duration -of default=noprint_wrappers=1:nokey=1 + +on the url" + (when (eq (emms-track-type track) 'url) + (with-temp-buffer + (call-process "ffprobe" nil t nil "-v" "error" "-show_entries" + "format=duration" "-of" "default=noprint_wrappers=1:nokey=1" + (emms-track-name track)) + (let ((duration (string-trim (buffer-string)))) + (when (string-match-p "[0-9.]+" duration) + (emms-track-set track 'info-playing-time + (floor (string-to-number duration)))))))) (provide 'my-emms) ;;; my-emms.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-epub.el b/emacs/.emacs.d/lisp/my/my-epub.el new file mode 100644 index 0000000..9c3ad59 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-epub.el @@ -0,0 +1,176 @@ +;;; my-epub.el -- epub utils -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "30.1")) + +;; 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: + +;; epub utils. + +;;; Code: + + +(defun my-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 my-epub-metadata (file-name) + "Get metadata of an epub file." + (when-let ((content-file-name (my-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))))) + `((title . ,title) + (authors . ,authors) + (year . ,year) + (identifier . ,identifier)) + ;; (pp metadata) + )) + )) + +;; generate epub +(defun my-epub-create (dir title author) + "Create an epub by concatenating htmls in DIR." + (let* ((name + (file-name-nondirectory (directory-file-name dir))) + (tmpdir + (make-temp-file (format "/tmp/%s.epub." name) t)) + (files (directory-files dir nil directory-files-no-dot-files-regexp))) + (my-epub--create-mimetype tmpdir) + (my-epub--create-container tmpdir) + (my-epub--create-opf tmpdir files title author) + (my-epub--create-toc tmpdir files title) + (my-epub--add-html + tmpdir + (directory-files dir t directory-files-no-dot-files-regexp)) + (my-epub--zip tmpdir name) + )) + +(defun my-epub--create-mimetype (dir) + (with-temp-buffer + (insert "application/epub+zip") + (write-file (file-name-concat dir "mimetype")))) + +(defun my-epub--create-container (dir) + (with-temp-buffer + (insert + "<?xml version=\"1.0\"?> +<container version=\"1.0\" xmlns=\"urn:oasis:names:tc:opendocument:xmlns:container\"> + <rootfiles> + <rootfile full-path=\"OEBPS/content.opf\" media-type=\"application/oebps-package+xml\"/> + </rootfiles> +</container>") + (make-directory + (file-name-concat dir "META-INF")) + (write-file (file-name-concat dir "META-INF/container.xml")))) + +(defun my-epub--create-opf (dir files title author) + (with-temp-buffer + (insert + "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" "\n") + (dom-print + `(package + ((unique-identifier . "BookID") + (version . "2.0")) + (metadata nil + (title nil ,title) + (creator nil ,author) + (language nil "en") + (identifier + ((id . "BookID")) + "Hello ID")) + (manifest + nil + (item ((id . "ncx") + (href . "toc.ncx") + (media-type . "application/x-dtbncx+xml"))) + ,@(seq-map + (lambda (file) + `(item ((id . ,file) + (href . ,file) + (media-type . "application/xhtml+xml")))) + files)) + (spine + ((toc . "ncx")) + ,@(seq-map + (lambda (file) + `(itemref ((idref . ,file)))) + files))) + t t) + (make-directory + (file-name-concat dir "OEBPS")) + (write-file (file-name-concat dir "OEBPS/content.opf")) + (message (buffer-string)))) + +(defun my-epub--create-toc (dir files title) + (with-temp-buffer + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" "\n") + (dom-print + `(ncx nil + (docTitle nil + (text nil ,title)) + (navMap + nil + ,@(seq-map + (lambda (file) + `(navPoint nil + (content ((src . ,file))))) + files))) + t t) + (write-file (file-name-concat dir "OEBPS/toc.ncx")))) + +(defun my-epub--add-html (dir files) + (seq-do + (lambda (file) + (copy-file file (file-name-concat dir "OEBPS/"))) + files)) + +(defun my-epub--zip (dir name) + (let ((default-directory dir)) + (call-process "zip" nil nil nil "-r" (format "/tmp/%s.epub" name) "."))) + +(provide 'my-epub) +;;; my-epub.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el index 6a2142b..7623548 100644 --- a/emacs/.emacs.d/lisp/my/my-gnus.el +++ b/emacs/.emacs.d/lisp/my/my-gnus.el @@ -419,5 +419,28 @@ The archiving target comes from `my-gnus-group-alist'." (let ((inhibit-message nil)) (message "Copied region with %d links." (length pairs))))) +(defun my-isync-sync-mail () + "Call `mbsync' to sync mail" + (interactive) + (message "isync in progress...") + (set-process-sentinel + (start-process "isync" "*isync*" "mbsync" "-a") + (lambda (proc event) + (let ((status (process-exit-status proc))) + (message "isync in progress...%s: %s" + (if (eq status 0) "done" "failed") + (with-current-buffer (process-buffer proc) + (goto-char (point-max)) + (re-search-backward "
") + (buffer-substring (1+ (point)) (point-max)))) + (gnus-group-get-new-news))))) + +(defun my-gnus-group-refresh (arg) + "Call `gnus-group-get-new-news' or, with a prefix arg, `my-isync-sync-mail'" + (interactive "P") + (if arg + (my-isync-sync-mail) + (gnus-group-get-new-news))) + (provide 'my-gnus) ;;; my-gnus.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el index c1f430f..a8e7dca 100644 --- a/emacs/.emacs.d/lisp/my/my-libgen.el +++ b/emacs/.emacs.d/lisp/my/my-libgen.el @@ -136,14 +136,13 @@ (alist-get 'coverurl info))))) (defun my-libgen-format-filename (info) - (replace-regexp-in-string "[:;?/]" "_" - (format - "%s - %s (%s) [%s].%s" - (alist-get 'author info) - (alist-get 'title info) - (alist-get 'year info) - (alist-get 'identifier info) - (alist-get 'extension info)))) + (my-make-doc-file-name (format + "%s - %s (%s) [%s].%s" + (alist-get 'author info) + (alist-get 'title info) + (alist-get 'year info) + (alist-get 'identifier info) + (alist-get 'extension info)))) (defvar my-libgen-download-dir "~/Downloads") @@ -162,13 +161,33 @@ id-head (downcase (alist-get 'md5 info))))) +(defun my-libgen-plus-make-download-link-onion (info) + (let* ((path + (dom-attr + (dom-search + (my-url-fetch-dom + (alist-get 'edition (my-libgen-plus-urls info))) + (lambda (n) + (string-match "r_[0-9]+_libgen" (or (dom-attr n 'href) "")))) + 'href)) + (id + (progn + (string-match "r_\\([0-9]+\\)_libgen" path) + (match-string 1 path))) + (id-head (substring id 0 -3))) + (format "%s/LG/%s%s/%s" + my-libgen-onion-host + (make-string (- 4 (length id-head)) ?0) + id-head + (downcase (alist-get 'md5 info))))) + (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)) + (my-wget-dom (alist-get 'ads (my-libgen-plus-urls info))) (lambda (n) (string-match (format "get\\.php\\?md5=%s" .md5) (or (dom-attr n 'href) "")))) @@ -186,6 +205,48 @@ nil (lambda () (my-libgen-check-md5 filename md5))))) +(defun my-libgen-plus-urls (info) + (let-alist info + `((ads . ,(format "%s/ads.php?md5=%s" my-libgen-plus-host .md5)) + (edition . ,(format "%s/edition.php?id=%s" my-libgen-plus-host + .edition-id)) + (file . ,(format "%s/file.php?id=%s" my-libgen-plus-host + .file-id))))) + +(defun my-libgen-plus-print-urls-action () + (interactive) + (pp (my-libgen-plus-urls (get-text-property (point) 'button-data)))) + +(defun my-libgen-plus-download-onion-action () + (interactive) + (let* ((info (get-text-property (point) 'button-data)) + (filename (file-name-concat (expand-file-name my-libgen-download-dir) + (my-libgen-format-filename info))) + (md5 (alist-get 'md5 info))) + (my-wget-async + (my-libgen-plus-make-download-link-onion info) + filename + nil + (lambda () (my-libgen-check-md5 filename md5))))) + +(defun my-libgen-plus-edition-infobox (info) + (let ((dom (my-url-fetch-dom + (alist-get 'edition (my-libgen-plus-urls info))))) + (infobox-render-string + (with-temp-buffer + (insert (mapconcat (lambda (p) (dom-texts p "")) + (dom-by-tag (dom-by-class dom "order-2") 'p) "\n")) + (shr-insert-document (dom-by-class dom "order-5")) + (buffer-string)) + `(my-libgen-plus-edition-infobox ,info) + (called-interactively-p 'interactive) + ) + )) + +(defun my-libgen-plus-infobox-action () + (interactive) + (my-libgen-plus-edition-infobox (get-text-property (point) 'button-data))) + (defun my-libgen-check-md5 (file md5) (let ((actual (substring (my-call-process-out "md5sum" file) 0 32))) (unless (equal actual md5) @@ -224,7 +285,9 @@ (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 "i" 'my-libgen-plus-infobox-action) + (define-key kmap "t" 'my-libgen-plus-download-onion-action) + (define-key kmap "u" 'my-libgen-plus-print-urls-action) ;; (define-key kmap "p" 'my-libgen-show-more-info) kmap)) @@ -323,6 +386,12 @@ (edition-id . ,edition-id) (identifier . ,identifier))))) +(defun my-libgen-plus-guess-md5 (mirrors) + (let ((joined + (string-join mirrors " "))) + (when (string-match "\\<[0-9a-f]\\{32\\}\\>" joined) + (match-string 0 joined)))) + (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))) @@ -343,7 +412,7 @@ (mirrors-td (elt tds 8)) (mirrors (seq-map (lambda (mirror) (dom-attr mirror 'href)) (dom-by-tag mirrors-td 'a))) - (md5 (when mirrors (substring (car mirrors) 4 36))) + (md5 (when mirrors (my-libgen-plus-guess-md5 mirrors))) ) `((title . ,title) (identifier . ,identifier) @@ -439,14 +508,13 @@ (alist-get 'filesize-human info))) (defun my-libfic-format-filename (info) - (replace-regexp-in-string "[:;]" "_" - (format - "%s - %s (%s) [%s].%s" - (alist-get 'author info) - (alist-get 'title info) - (alist-get 'series info) - (alist-get 'identifier info) - (alist-get 'extension info)))) + (my-make-doc-file-name (format + "%s - %s (%s) [%s].%s" + (alist-get 'author info) + (alist-get 'title info) + (alist-get 'series info) + (alist-get 'identifier info) + (alist-get 'extension info)))) (defun my-grok-libfic-action (info) (interactive) diff --git a/emacs/.emacs.d/lisp/my/my-mariadb.el b/emacs/.emacs.d/lisp/my/my-mariadb.el index d6c2463..1759af2 100644 --- a/emacs/.emacs.d/lisp/my/my-mariadb.el +++ b/emacs/.emacs.d/lisp/my/my-mariadb.el @@ -65,7 +65,7 @@ (replace-regexp-in-string "/src" "/build/mysql-test/var/log/mysqld.1.1.rr/latest-trace" - ;; "/build/mysql-test/var/log/mysqld.2.2.rr/latest-trace" + ;; "/build/mysql-test/var/log/mysqld.2.1.rr/latest-trace" (project-root (project-current t)))) (expand-file-name "~/bin/gdb-mi.sh")))) @@ -291,11 +291,24 @@ switches to the buffer." (my-save-text-and-switch-to-buffer source file-name))) (defvar my-mtr-compilation-error-re - '(mtr "^mysqltest: At line \\([0-9]+\\)" nil 1)) + '(mtr "^\\([^ ]+\\) +\\(w[0-9]+ \\)?\\[ fail \\]" + my-mtr-compilation-error-filename)) -;; (defun my-mtr-find-test-file (test-name &optional dir) -;; (unless dir (setq dir default-directory)) -;; ()) +(defun my-mtr-compilation-error-filename () + (save-excursion + (save-match-data + (my-mtr-find-test-file + (match-string 1) + (project-root (project-current)))))) + +(defun my-mtr-find-test-file (test-name dir) + (pcase-let ((`(,suite ,base) (string-split test-name "\\."))) + (seq-find + (lambda (file) + (string-match-p (format "%s\\(/t\\)?/%s.test$" suite base) file)) + (directory-files-recursively dir + (format "%s.test" base)))) + ) (defun my-mtr-set-compile-command () (when (and buffer-file-name @@ -306,11 +319,11 @@ switches to the buffer." (test-name (progn (when (string-match - "^.*/mysql-test/\\(.+?\\)/\\(t/\\)?\\([^/]+\\)\\.test$" + "^.*/mysql-test/\\(suite/\\)?\\(.+?\\)/\\(t/\\)?\\([^/]+\\)\\.test$" buffer-file-name) (format "%s.%s" - (match-string 1 buffer-file-name) - (match-string 3 buffer-file-name)))))) + (match-string 2 buffer-file-name) + (match-string 4 buffer-file-name)))))) (setq-local compile-command (format "%s %s %s %s" @@ -319,5 +332,42 @@ switches to the buffer." test-name "--rr"))))) +(defun my-mtr-remove-if-1 () + "Remove if (1) blocks" + (interactive) + (while (re-search-forward + (rx bol (0+ space) "if" (0+ space) "(1)" (0+ space) eol) + nil t) + (kill-whole-line) + (my-delete-pair-dwim))) + +(defun my-mtr-remove-if-0 () + "Remove if (0) blocks" + (interactive) + (while (re-search-forward + (rx bol (0+ space) "if" (0+ space) "(0)" (0+ space) eol) + nil t) + (kill-whole-line) + (kill-sexp))) + +(defun my-mtr-average () + "Calculate average time of mtr --repeat output." + (interactive) + (let ((run (make-hash-table :test 'equal)) + (name) (time)) + (while (re-search-forward "^\\([^ ]+\\).*pass \\] +\\([0-9]+\\)$" nil t) + (setq name (match-string 1) + time (string-to-number (match-string 2))) + (puthash name (cons time (gethash name run)) run)) + (with-temp-buffer + (maphash + (lambda (k v) + (insert k " " (format "%d" (/ (seq-reduce '+ v 0) (length v))) "\n")) + run) + (goto-char (point-min)) + (sort-lines nil (point-min) (point-max)) + (align-regexp (point-min) (point-max) "\\(\\s-*\\) ") + (message (buffer-string))))) + (provide 'my-mariadb) ;;; my-mariadb.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-markup.el b/emacs/.emacs.d/lisp/my/my-markup.el index 2b1c7f6..2901f13 100644 --- a/emacs/.emacs.d/lisp/my/my-markup.el +++ b/emacs/.emacs.d/lisp/my/my-markup.el @@ -64,5 +64,31 @@ (when-let ((text (dom-text (my-xml-get-first-child node tag)))) (replace-regexp-in-string "\n" " " (string-trim text)))) +(defun my-html-render (arg) + (interactive "P") + (if arg + (browse-url-of-buffer) + (let ((show-trailing-whitespace nil)) + (call-interactively 'shr-render-buffer) + (view-mode)))) + +(defvar-keymap htmlv-mode-map + "." #'htmlv-reopen-as-html + ) + +(define-derived-mode htmlv-mode special-mode "HTML View" + "Major mode for viewing HTML documents." + (let ((inhibit-read-only t)) + (shr-render-region (point-min) (point-max))) + (set-buffer-modified-p nil) + (goto-char (point-min))) + +(defun htmlv-reopen-as-html () + (interactive) + (with-current-buffer + (cl-letf (((symbol-function 'y-or-n-p) #'always)) + (find-file-literally buffer-file-name)) + (mhtml-mode))) + (provide 'my-markup) ;;; my-markup.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-media-segment.el b/emacs/.emacs.d/lisp/my/my-media-segment.el index f222316..e8ee5cc 100644 --- a/emacs/.emacs.d/lisp/my/my-media-segment.el +++ b/emacs/.emacs.d/lisp/my/my-media-segment.el @@ -50,18 +50,93 @@ The process can be started by applying 'start-process' on START-PROCESS-ARGS." (when my-media-segment-queued-jobs (funcall (pop my-media-segment-queued-jobs)))) -(defun my-segment-media-file-1 (media-file-name desc-file-name) +(defun my-ffmpeg-split-file (file-name split-at) + "Split FILE-NAME at SPLIT-AT into two files." + (let* ((name-no-ext (file-name-sans-extension file-name)) + (ext (file-name-extension file-name)) + (file-name-1 (make-temp-file (format "%s-1-" name-no-ext) nil + (format ".%s" ext))) + (file-name-2 (make-temp-file (format "%s-2-" name-no-ext) nil + (format ".%s" ext)))) + (message "Splitting %s at %s into %s and %s..." + file-name split-at file-name-1 file-name-2) + (set-process-sentinel + (start-process (format "ffmpeg-%s" file-name) + (format "*ffmpeg-%s*" file-name) + "ffmpeg" + "-i" file-name + "-to" split-at "-c" "copy" file-name-1 + "-ss" split-at "-c" "copy" file-name-2 + "-y") + (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "Splitting %s at %s into %s and %s... Done" + file-name split-at file-name-1 file-name-2)) + (message "Splitting %s at %s into %s and %s... Failed: %s" + file-name split-at file-name-1 file-name-2 event))))))) + +(defun my-dired-do-ffmpeg-split-file () + (interactive) + (seq-do + (lambda (file) + (my-ffmpeg-split-file file (read-string + (format "Split %s at: " file)))) + (dired-get-marked-files))) + +(defun my-segment-media-file-2 (media-file-name info-file-name) + "Run ffmpeg to segment MEDIA-FILE-NAME according to INFO-FILE-NAME in one go. + +Much faster than my-segment-media-file or my-segment-media-file-1." + (interactive (list + (read-file-name "Choose media file: ") + (read-file-name + "Choose description file (.info.json or .description): "))) + (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) + (info (my-get-media-segments info-file-name)) + (total (length info)) + (pad (1+ (floor (log10 total)))) + (idx 0) + (args `("-i" ,(expand-file-name media-file-name)))) + (ignore-errors (dired-create-directory dir)) + (dolist (media info) + (setq idx (1+ idx)) + (let* ((title (plist-get media :title)) + (start (plist-get media :start)) + (end (plist-get media :end))) + (setq args (append args + `("-ss" ,start) + (when end `("-to" ,end)) + `("-c" "copy" + ,(format + (format "%%s/%%0%dd-%%s.%%s" pad) dir idx title + (file-name-extension media-file-name))))) + (message "Will cut %s-%s to %s (%d/%d)..." + start (or end "") title idx total))) + (set-process-sentinel + (apply 'start-process + (append `(,(format "ffmpeg-%s" media-file-name) + ,(format "*ffmpeg-%s*" media-file-name) + "ffmpeg") + args)) + (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "Cutting %s: All DONE" media-file-name)) + (message "Cutting %s FAILED: %s" media-file-name event))))))) + +(defun my-segment-media-file-1 (media-file-name info-file-name) "Run ffmpeg asynchronously to segment file-name according to description. Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (interactive (list (read-file-name "Choose media file: ") - (read-file-name "Choose description file: "))) + (read-file-name + "Choose description file (.info.json or .description): "))) (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) - (info (my-get-media-segments - (with-temp-buffer - (insert-file-contents desc-file-name) - (buffer-string)))) + (info (my-get-media-segments info-file-name)) (total (length info)) (pad (1+ (floor (log10 total)))) (idx 0) @@ -94,12 +169,31 @@ Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (funcall thunk) (my-media-segment-enqueue-process thunk)))))) -(defun my-get-media-segments (description) +(defun my-get-media-segments (info-file-name) + (if (equal (file-name-extension info-file-name) "json") + (my-get-media-segments-from-json info-file-name) + (my-get-media-segments-from-descr info-file-name))) + +(defun my-get-media-segments-from-json (json-file-name) + (let ((info + (with-temp-buffer + (insert-file-contents json-file-name) + (goto-char (point-min)) + (json-read)))) + (seq-map + (lambda (ch) + (let-alist ch + ;; .title: ytdl; .tags.titile: .m4b + (list :title (my-make-doc-file-name (or .title .tags.title)) + :start (format "%s" .start_time) + :end (format "%s" .end_time)))) + (alist-get 'chapters info)))) + +(defun my-get-media-segments-from-descr (descr-file-name) "Output title start end triplets." (let ((results) (title) (start) (end)) (with-temp-buffer - (erase-buffer) - (insert description) + (insert-file-contents descr-file-name) (goto-char (point-min)) (save-excursion (while (re-search-forward @@ -116,7 +210,7 @@ Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (buffer-substring-no-properties (point) (progn (beginning-of-line 2) (point)))))) - (push (list :title (my-make-filename title) :start start :end end) results) + (push (list :title (my-make-doc-file-name title) :start start :end end) results) ) (setq end nil) (dolist (result results) @@ -127,19 +221,16 @@ Uses `my-media-segment-max-inflight' to limit number of inflight tasks." ))) (defvar my-segment-media-max-async 10) -(defun my-segment-media-file (media-file-name desc-file-name synchronously) +(defun my-segment-media-file (media-file-name info-file-name synchronously) "Run ffmpeg asynchronously to segment file-name according to description. With a prefix-arg, run synchronously." (interactive (list (read-file-name "Choose media file: ") - (read-file-name "Choose description file: ") + (read-file-name "Choose info file: ") current-prefix-arg)) (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) - (info (my-get-media-segments - (with-temp-buffer - (insert-file-contents desc-file-name) - (buffer-string)))) + (info (my-get-media-segments info-file-name)) (total (length info)) (idx 0)) (when (or synchronously (<= total my-segment-media-max-async) diff --git a/emacs/.emacs.d/lisp/my/my-net.el b/emacs/.emacs.d/lisp/my/my-net.el index 6212b50..a608808 100644 --- a/emacs/.emacs.d/lisp/my/my-net.el +++ b/emacs/.emacs.d/lisp/my/my-net.el @@ -29,6 +29,7 @@ ;;; net utilities (defvar my-download-dir "~/Downloads") +(defvar my-webpage-incoming-dir "~/Downloads") (defmacro my-url-as-googlebot (&rest body) "Run BODY while spoofing as googlebot" diff --git a/emacs/.emacs.d/lisp/my/my-nov.el b/emacs/.emacs.d/lisp/my/my-nov.el index 9a819c7..21df675 100644 --- a/emacs/.emacs.d/lisp/my/my-nov.el +++ b/emacs/.emacs.d/lisp/my/my-nov.el @@ -28,22 +28,51 @@ (require 'nov) +(defvar my-nov-mode-line-format "%p%% %t: %c") +(defvar-local my-nov-title nil) +(defvar-local my-nov-chapter-title nil) +(defvar-local my-nov-position-percent nil) + ;; override nov-render-title ;; this is because header line does not work with follow mode (defun my-nov-render-title (dom) "Custom <title> rendering function for DOM. Sets `header-line-format' to a combination of the EPUB title and chapter title." - (let ((title (cdr (assq 'title nov-metadata))) - (chapter-title (car (esxml-node-children dom)))) - (when (not chapter-title) - (setq chapter-title "No title")) - ;; this shouldn't happen for properly authored EPUBs - (when (not title) - (setq title "No title")) + (setq my-nov-title (cdr (assq 'title nov-metadata)) + my-nov-chapter-title (car (esxml-node-children dom)))) + +(defun my-nov-update-mode-line () + (setq my-nov-position-percent + (/ (* 100 (my-nov-word-position)) my-nov-total-word-count)) + (let ((title (or my-nov-title (propertize "No title" 'face 'italic))) + (chapter-title (or my-nov-chapter-title + (propertize "No title" 'face 'italic)))) (setq mode-line-buffer-identification - (concat title ": " chapter-title)) - )) + (format-spec + my-nov-mode-line-format + `((?c . ,chapter-title) + (?t . ,title) + (?p . ,my-nov-position-percent)))))) + +(defun my-nov-render-span (dom) + (unless (equal (dom-attr dom 'epub:type) "pagebreak") + (shr-generic dom))) + +;;; TODO: perhaps no indentation? +(defun my-nov-render-ol (dom) + (shr-ensure-paragraph) + (let* ((attrs (dom-attributes dom)) + (start-attr (alist-get 'start attrs)) + ;; Start at 1 if there is no start attribute + ;; or if start can't be parsed as an integer. + (start-index (condition-case _ + (cl-parse-integer start-attr) + (t nil))) + (shr-list-mode (or start-index 'ul)) + (shr-internal-bullet `(" " . ,(shr-string-pixel-width " ")))) + (shr-generic dom)) + (shr-ensure-paragraph)) (defun my-nov-find-file-with-ipath (file-name ipath) "Find epub file and goto IPATH. @@ -84,5 +113,98 @@ Useful for recoll." (visual-line-mode) ) +(defvar-local my-nov-document-word-counts nil + "Word count of each nov document.") + +(defvar-local my-nov-total-word-count nil + "Total word count of the epub.") + +(defun my-nov-count-words () + (interactive) + (unless my-nov-document-word-counts + (message "Counting words...") + (setq my-nov-document-word-counts + (apply + 'vector + (seq-map + (lambda (doc) + (with-temp-buffer + (pcase-let ((`(,name . ,file) doc)) + (insert-file-contents file) + (nov-render-html) + (cons name (count-words (point-min) (point-max)))))) + nov-documents))) + (setq my-nov-total-word-count + (seq-reduce + (lambda (sum pair) + (+ sum (cdr pair))) + my-nov-document-word-counts + 0)) + (message "Counting words...done"))) + +(defun my-nov-stats () + (interactive) + (message "%d words; %d standard pages" + my-nov-total-word-count + (ceiling (/ my-nov-total-word-count 300.0)))) + +;;; TODO: also show current percentage in the total book in the mode +;;; line +(defun my-nov-goto-nth-word (n) + "Go to the nth word of the current epub." + (my-nov-count-words) + (setq nov-documents-index -1) + (let ((found + (seq-find + (lambda (pair) + (setq n (- n (cdr pair))) + (setq nov-documents-index (1+ nov-documents-index)) + (<= n 0)) + my-nov-document-word-counts))) + (nov-render-document) + (if (> n 0) + (end-of-buffer) + (forward-word (+ n (cdr found))))) + ) + +(defun my-nov-word-position () + "Where are we in terms of word position? + +Return n, such that nth word of the epub is at point." + (my-nov-count-words) + (let ((result 0)) + (dotimes (i nov-documents-index) + (setq result (+ result (cdr (aref my-nov-document-word-counts i))))) + (setq result (+ result (count-words (point-min) (point)))))) + +(defun my-nov-skim-forward () + "Forward by 3-10% of the book." + (interactive) + (let ((pc (+ 3 (random 8)))) + (my-nov-goto-nth-word + (+ (my-nov-word-position) + (/ (* my-nov-total-word-count pc) 100))) + (message "Skimmed forward by %d%% of the book" pc))) + +(defun my-nov-skim-backward () + "Backward by 3-10% of the book." + (interactive) + (let ((pc (+ 3 (random 8)))) + (my-nov-goto-nth-word + (max + 0 + (- (my-nov-word-position) + (/ (* my-nov-total-word-count pc) 100)))) + (message "Skimmed backward by %d%% of the book" pc))) + +(defun my-nov-goto-random-position () + "Goto a random position in the epub." + (interactive) + (my-nov-count-words) + (let ((n (random my-nov-total-word-count))) + (my-nov-goto-nth-word n) + (message "Went to the %dth word (%d%% of the book)." + n (/ (* n 100) my-nov-total-word-count)))) + (provide 'my-nov) ;;; my-nov.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-org-remark.el b/emacs/.emacs.d/lisp/my/my-org-remark.el index 3e0ef0a..4582f6c 100644 --- a/emacs/.emacs.d/lisp/my/my-org-remark.el +++ b/emacs/.emacs.d/lisp/my/my-org-remark.el @@ -26,6 +26,71 @@ ;;; Code: + +;;; override `org-remark-highlight-add-or-update-highlight-headline' +(defun my-org-remark-highlight-add-or-update-highlight-headline (highlight source-buf notes-buf) + "Add a new HIGHLIGHT headlne to the NOTES-BUF or update it. +Return notes-props as a property list. + +HIGHLIGHT is an overlay from the SOURCE-BUF. + +Assume the current buffer is NOTES-BUF and point is placed on the +beginning of source-headline, which should be one level up." + ;; Add org-remark-link with updated line-num as a property + (let (title beg end props id text filename link orgid org-remark-type other-props) + (with-current-buffer source-buf + (setq title (org-remark-highlight-get-title) + beg (overlay-start highlight) + end (overlay-end highlight) + props (overlay-properties highlight) + id (plist-get props 'org-remark-id) + org-remark-type (overlay-get highlight 'org-remark-type) + text (org-with-wide-buffer + (org-remark-highlight-headline-text highlight org-remark-type)) + filename (org-remark-source-get-file-name + (org-remark-source-find-file-name)) + link (run-hook-with-args-until-success + 'org-remark-highlight-link-to-source-functions filename beg) + orgid (org-remark-highlight-get-org-id beg) + other-props (org-remark-highlight-collect-other-props highlight)) + ;; TODO ugly to add the beg end after setq above + (plist-put props org-remark-prop-source-beg (number-to-string beg)) + (plist-put props org-remark-prop-source-end (number-to-string end)) + (when link (plist-put props "org-remark-link" link)) + (when other-props (setq props (append props other-props)))) + ;;; Make it explicit that we are now in the notes-buf, though it is + ;;; functionally redundant. + (with-current-buffer notes-buf + (let ((highlight-headline (org-find-property org-remark-prop-id id)) + ;; Assume point is at the beginning of the parent headline + (level (1+ (org-current-level)))) + (if highlight-headline + (progn + (goto-char highlight-headline) + ;; Update the existing headline and position properties + ;; Don't update the headline text when it already exists. + ;; Let the user decide how to manage the headlines + ;; (org-edit-headline text) + (org-remark-notes-set-properties props)) + ;; No headline with the marginal notes ID property. Create a new one + ;; at the end of the file's entry + (org-narrow-to-subtree) + (goto-char (point-max)) + ;; Ensure to be in the beginning of line to add a new headline + (when (eolp) (open-line 1) (forward-line 1) (beginning-of-line)) + ;; Create a headline + ;; Add a properties + (insert (concat (insert-char (string-to-char "*") level) + " " (my-elide-text text fill-column) "\n")) + ;; org-remark-original-text should be added only when this + ;; headline is created. No update afterwards + (plist-put props "org-remark-original-text" text) + (org-remark-notes-set-properties props) + (when (and orgid org-remark-use-org-id) + (insert (concat "[[id:" orgid "]" "[" title "]]")))) + (list :body (org-remark-notes-get-body) + :original-text text))))) + (defun my-org-remark-open-or-create () (interactive) (if mark-active diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el index f870d4f..5a50673 100644 --- a/emacs/.emacs.d/lisp/my/my-org.el +++ b/emacs/.emacs.d/lisp/my/my-org.el @@ -28,6 +28,7 @@ (require 'org) +(require 'tor) ;;; org mode (defun my-org-open-shell-at-attach-dir () @@ -179,8 +180,8 @@ notes file." (with-current-buffer (find-file-noselect org-default-notes-file) (clone-indirect-buffer nil t) (setq my-notes-buffer-list - (setq-filter 'my-buffer-with-same-base-p - (buffer-list)))) + (seq-filter 'my-buffer-with-same-base-p + (buffer-list)))) (if (eq last-command 'my-org-open-or-cycle-notes) (progn (setq my-notes-buffer-list @@ -1662,5 +1663,28 @@ dual relation link-back on that task." (and (org-entry-get (point) "BLOCKED_BY") (member (org-entry-get nil "TODO") org-not-done-keywords))) +(defun my-org-clock-split () + "Split the clock entry at the current line." + (interactive) + (let ((line (buffer-substring (line-beginning-position) (line-end-position)))) + (unless (string-match org-element-clock-line-re line) + (error "Not at an org clock line")) + (let* ((start (match-string 1 line)) + (end (match-string 2 line)) + (mid (org-read-date t 'to-time nil "Split org clock at: " nil start))) + (back-to-indentation) + (kill-line) + (insert "CLOCK: [" start "]--") + (org-insert-time-stamp mid t t) + (org-clock-update-time-maybe) + + (my-new-line-above-or-below) + (insert "CLOCK: ") + (org-insert-time-stamp mid t t) + (insert "--[" end "]") + (org-clock-update-time-maybe) + )) + ) + (provide 'my-org) ;;; my-org.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el index 92fcf21..eead408 100644 --- a/emacs/.emacs.d/lisp/my/my-prog.el +++ b/emacs/.emacs.d/lisp/my/my-prog.el @@ -444,7 +444,12 @@ overlay arrow in source buffer." (defun my-gud-watch-expr (expr) (with-current-buffer gud-comint-buffer - (insert "watch -l " expr) + (insert "wl " expr) + (comint-send-input))) + +(defun my-gud-break-expr (expr) + (with-current-buffer gud-comint-buffer + (insert "b " expr) (comint-send-input))) (defun my-gud-print-expr (expr) @@ -454,11 +459,12 @@ overlay arrow in source buffer." (defun my-gud-print-expr-region (b e) (interactive "r") - (unless (eq (gdb-get-source-buffer) (current-buffer)) - (error "Not in the source buffer")) - (if current-prefix-arg - (my-gud-watch-expr (buffer-substring b e)) - (my-gud-print-expr (buffer-substring b e)))) + (let ((selection (buffer-substring b e))) + (pcase (prefix-numeric-value current-prefix-arg) + (16 (my-gud-break-expr selection)) + (4 (my-gud-watch-expr selection)) + (_ (my-gud-print-expr selection)))) + (deactivate-mark)) ;;; which-func (defun my-copy-which-func () @@ -466,11 +472,19 @@ overlay arrow in source buffer." (kill-new (which-function)) ) +(defun my-copy-with-func (b e) + (interactive "r") + (kill-new + (concat comment-start "in " (which-function) ":" comment-end "\n" + (buffer-substring b e))) + (deactivate-mark) + (message "Copied current region with function name")) + (defun my-set-header-line-to-which-func () (setq header-line-format - '((which-func-mode - ("" which-func-format " ") - )))) + '((which-func-mode + ("" which-func-format " ") + )))) ;; override bookmark-make-record for easier default bookmark name. (defun my-bookmark-make-record () diff --git a/emacs/.emacs.d/lisp/my/my-ttrss.el b/emacs/.emacs.d/lisp/my/my-ttrss.el new file mode 100644 index 0000000..046f596 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-ttrss.el @@ -0,0 +1,200 @@ +;;; my-ttrss.el -- ttrss utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "30.1")) + +;; 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: + +;; ttrss utilities. + +;;; Code: + +(require 'ttrss) +(require 'my-utils) +(require 'org-macs) + +;;; TODO: my-ttrss-save-recent + +(defun my-ttrss-hello () + (let ((sid (ttrss-login ttrss-address ttrss-user ttrss-password))) + (message "Server running version %s and API level %d\n" + (ttrss-get-version ttrss-address sid) + (ttrss-get-api-level ttrss-address sid)) + (message "There are %s unread articles in %d feeds" + (ttrss-get-unread ttrss-address sid) + (length (ttrss-get-feeds ttrss-address sid :unread_only t))))) + +(defun my-ttrss-fetch-feeds () + (let ((sid (ttrss-login ttrss-address ttrss-user ttrss-password))) + (ttrss-get-feeds ttrss-address sid :cat_id -3))) + +(defun my-ttrss-feed-dir (feed-title feed-id) + (file-name-concat + my-ttrss-dir + (my-make-doc-file-name + (format "%s [ttrss%s]" feed-title feed-id)))) + +(defun my-ttrss-feed-last-id-file (feed-info) + (let* ((title (plist-get feed-info :title)) + (id (plist-get feed-info :id))) + (expand-file-name + (file-name-concat (my-ttrss-feed-dir title id) "last-id")))) + +(defun my-ttrss-feed-get-last-id (feed-info) + (let* ((file (my-ttrss-feed-last-id-file feed-info))) + (if (file-exists-p file) + (with-temp-buffer + (insert-file-contents file) + (string-to-number (buffer-string))) + 0))) + +(defun my-ttrss-feed-write-last-id (feed-info last-id) + (let* ((file (my-ttrss-feed-last-id-file feed-info)) + (inhibit-message t)) + (with-temp-buffer + (insert (format "%d" last-id)) + (write-file file)))) + +(defun my-ttrss-fetch () + "Fetch and save latest articles from all feeds." + (interactive) + (let* ((sid (ttrss-login ttrss-address ttrss-user ttrss-password)) + (feeds (ttrss-get-feeds ttrss-address sid :cat_id -3)) + (n (length feeds))) + (seq-do-indexed + (lambda (feed i) + (my-ttrss-fetch-feed-articles + sid feed + (format "[my-ttrss] (%d/%d) Fetching articles from %s..." + (1+ i) n (plist-get feed :title)))) + feeds))) + +(defun my-ttrss-fetch-feed-articles (sid feed &optional message-head) + (unless message-head + (setq message-head + (format "[my-ttrss] Fetching articles from %s..." + (plist-get feed :title)))) + (message "%s" message-head) + (let ((articles + (ttrss-get-headlines + ttrss-address sid + :feed_id (plist-get feed :id) :show_content t :include_attachments t + :since_id (my-ttrss-feed-get-last-id feed)))) + (seq-do 'my-ttrss-save-article articles) + (unless (seq-empty-p articles) + (my-ttrss-feed-write-last-id + feed + (seq-reduce + (lambda (acc article) (max acc (plist-get article :id))) + articles + 0))) + (message + "%s Done - total %d articles" + message-head (length articles)))) + +(defun my-ttrss-fetch-latest-articles (n &optional since-id) + "Fetch N latest articles." + (let ((sid (ttrss-login ttrss-address ttrss-user ttrss-password))) + (unless since-id (setq since-id 0)) + (if (ttrss-logged-in-p ttrss-address sid) + (ttrss-get-headlines + ttrss-address sid + :feed_id -4 :limit n :show_content t :include_attachments t + :since_id since-id) + (message "Login failed")))) + +(defun my-ttrss-save-article (info) + (with-temp-buffer + (insert "<!--\n Page saved with my-ttrss on " + (current-time-string) "\n" + (json-serialize (org-plist-delete info :content)) + "\n-->\n") + (insert "<h2>" "<a href=\"" (plist-get info :link) "\">" + (plist-get info :title) "</a>" "</h2>") + (insert "<p>" "<a href=\"" (plist-get info :site_url) "\">" + (plist-get info :feed_title) "</a>") + (when-let ((author (plist-get info :author))) + (unless (or (string-empty-p author) + (equal author (plist-get info :feed_title))) + (insert " (" author ")"))) + (let ((updated (format-time-string + "%Y-%m-%d %a %H:%M:%S" + (encode-time (decode-time (plist-get info :updated)))))) + (insert " " updated) + (insert "</p>") + (let ((tags (plist-get info :tags))) + (unless (seq-empty-p tags) + (insert "<p>tags: " (string-join tags ";") "</p>"))) + (insert (plist-get info :content)) + (let ((attached (plist-get info :attachments))) + (unless (seq-empty-p attached) + (insert "<p>Article attachments:</p>\n<ul>") + (seq-do (lambda (at) + (let ((title (plist-get at :title)) + (url (plist-get at :content_url))) + (insert "\n<li><a href=" url ">" + (if (string-empty-p title) url title) + "</a></li>"))) + attached) + (insert "\n</ul>"))) + (let* ((change-major-mode-with-file-name nil) + (coding-system-for-write 'utf-8) + (inhibit-message t) + (file-name (my-ttrss-format-file-name info)) + (dir (file-name-directory file-name))) + (unless (file-exists-p dir) (make-directory dir t)) + (write-file file-name) + (my-touch-file-mtime file-name updated))))) + +(defvar my-ttrss-dir "~/Downloads") + +(defun my-ttrss-format-file-name (info) + "Format: $author - $title ($year) [ttrss$id].html" + (let* ((author (plist-get info :author)) + (feed-title (plist-get info :feed_title)) + (feed-id (plist-get info :feed_id)) + (name + (expand-file-name + (file-name-concat + (my-ttrss-feed-dir feed-title feed-id) + (my-make-doc-file-name + (format "%s - %s (%s) [ttrss%s].html" + (if (string-empty-p author) + feed-title + author) + (plist-get info :title) + (format-time-string + "%Y" + (encode-time (decode-time (plist-get info :updated)))) + (plist-get info :id))))))) + (if (length> name 250) + (expand-file-name + (file-name-concat + (my-ttrss-feed-dir feed-title feed-id) + (my-make-doc-file-name + (format "_ - _ (%s) [ttrss%s].html" + (format-time-string + "%Y" + (encode-time (decode-time (plist-get info :updated)))) + (plist-get info :id))))) + name))) + +(provide 'my-ttrss) +;;; my-ttrss.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el index 0743227..05ca2e6 100644 --- a/emacs/.emacs.d/lisp/my/my-utils.el +++ b/emacs/.emacs.d/lisp/my/my-utils.el @@ -226,6 +226,9 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" (replace-regexp-in-string "[[:punct:][:space:]\n\r]+" sep (string-trim name))) +(defun my-make-doc-file-name (name) + (replace-regexp-in-string "[:;?/]" "_" name)) + (defun my-make-filename-from-url (url) (let* ((urlobj (url-generic-parse-url url)) (filename (url-filename urlobj)) @@ -295,6 +298,7 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" (defvar my-video-incoming-dir my-incoming-dir) (defvar my-audio-incoming-dir my-incoming-dir) (defvar my-document-incoming-dir my-incoming-dir) +(defvar my-music-incoming-dir my-incoming-dir) (defmacro my-with-default-directory (dir &rest body) "Run BODY with the default directory." @@ -311,21 +315,13 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" (apply 'call-process (append (list command nil t nil) args)) (buffer-string))) -(defun my-call-process-with-torsocks - (program &optional infile destination display &rest args) - (apply 'call-process - (append (list "torsocks" infile destination display program) args))) - -(defun my-start-process-with-torsocks (no-tor name buffer program &rest program-args) - (if no-tor - (apply 'start-process (append (list name buffer program) program-args)) - (apply 'start-process - (append (list name buffer "torsocks" program) program-args)))) - (defun my-touch-new-file (filename) "Touch a new file." (with-temp-buffer (write-file filename))) +(defun my-touch-file-mtime (file date) + (call-process "touch" nil nil nil "-d" date file)) + (defvar my-extension-types '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus" "wav" "wma" "spc" "mp4")) diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el index d1eacb6..87c319f 100644 --- a/emacs/.emacs.d/lisp/my/my-web.el +++ b/emacs/.emacs.d/lisp/my/my-web.el @@ -59,14 +59,15 @@ (interactive) (let ((url (plist-get eww-data :url))) (when (and (string-match "^\\(.*//.*?/\\).*$" url) - (match-string 1 url)) + (match-string 1 url)) (eww (match-string 1 url))))) +(defvar my-tor-browser-bin "tor-browser") + (defun my-browse-url-tor-browser (url) "Browse URL with tor-browser." (setq url (browse-url-encode-url url)) - (start-process (concat "tor-browser " url) nil "tor-browser" - "--allow-remote" url)) + (start-process "tor-browser" nil my-tor-browser-bin "--allow-remote" url)) (defun my-browse-url-firefox-private (url) "Browse URL in a private firefox window." @@ -146,10 +147,10 @@ Useful for bypassing \"Enable JavaScript and cookies to continue\"." (if no-overwrite (my-make-unique-file-name (my-make-file-name-from-url url) - my-download-dir) + my-webpage-incoming-dir) (expand-file-name (my-make-file-name-from-url url "html") - my-download-dir)))) + my-webpage-incoming-dir)))) (url-copy-file url file-name (not no-overwrite)) (browse-url-firefox (format "file://%s" file-name)))) @@ -252,5 +253,71 @@ https://emacs.stackexchange.com/questions/40887/in-org-mode-how-do-i-link-to-int (lambda (_) (funcall my-url-context-function url))))) +(defvar my-dw-host "dw.com") + +(defun my-dw-parse-article-url (url) + "Returns (lang . article-id)" + (let* ((urlobj (url-generic-parse-url url)) + (path (url-filename urlobj)) + (components (string-split path "/"))) + `(,(elt components 1) . ,(string-remove-prefix "a-" (elt components 3))))) + +(defun my-dw-article-api (url) + (pcase-let ((`(,lang . ,id) (my-dw-parse-article-url url))) + (my-url-fetch-json + (format "https://%s/graph-api/%s/content/article/%s" my-dw-host lang id)))) + +(defun my-dw-extract (info) + "Returns list of (url . file-name) pairs." + (let* ((content (alist-get 'content (alist-get 'data info))) + (dir (file-name-concat my-audio-incoming-dir + (my-make-doc-file-name + (alist-get 'title content)))) + (audios (alist-get 'audios content))) + (seq-map + (lambda (audio) + (let ((url (alist-get 'mp3Src audio))) + `(,url + . + ,(expand-file-name + (file-name-concat dir (file-name-with-extension + (my-make-doc-file-name + (alist-get 'name audio)) + (file-name-extension url))))))) + audios))) + +(defun my-dw-download (pairs) + "Download list of (url . file-name) pairs with aria2." + (let ((file (make-temp-file "/tmp/aria2")) + (n (length pairs))) + (with-temp-file file + (dolist (pair pairs) + (insert (car pair) "\n out=" (cdr pair) "\n")) + ;; (buffer-string) + ) + (message "Downloading %d files..." n) + (set-process-sentinel + (start-process "aria2" "*aria2*" "aria2c" "-x" "5" "-d" "/" + "-R" "true" "-i" file) + (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "Downloading %d files...Done" n)) + (message "Downloading %d files...Failed: %s" n event))))))) + +(defun my-dw-download-url (url) + (interactive "sDW Download URL: ") + (my-dw-download (my-dw-extract (my-dw-article-api url)))) + +(defun my-dw-download-urls (urls) + (my-dw-download (seq-mapcat + (lambda (url) (my-dw-extract (my-dw-article-api url))) + urls))) + +(defun my-local-archive-open-url (url) + "Open url from local archive." + ) + (provide 'my-web) ;;; my-web.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-wget.el b/emacs/.emacs.d/lisp/my/my-wget.el index e7283aa..f3f6771 100644 --- a/emacs/.emacs.d/lisp/my/my-wget.el +++ b/emacs/.emacs.d/lisp/my/my-wget.el @@ -30,6 +30,7 @@ ;; wget (require 'wget) (require 'my-utils) +(require 'tor) (defvar my-wget-video-archive-directory) ;; FIXME: this list is rather random... (setq my-wget-video-extensions '("mp4" "flv" "mkv" "webm" "ogv" "avi" @@ -53,8 +54,7 @@ (my-start-process-with-torsocks no-tor "wget" "*wget*" "wget" url "-c" "-O" filename) (lambda (proc event) - (let ((ps (process-status proc)) - (status (process-exit-status proc))) + (let ((status (process-exit-status proc))) (if (eq status 0) (progn (message "[DONE] Fetched %s to %s" url filename) @@ -86,5 +86,22 @@ no-tor move-if-video-or-large) (setq i (1+ i))))) +(defun my-wget-out-internal (url buffer-processor &optional no-tor) + "Run wget on url, dump the results in a temp buffer, then apply BUFFER-PROCESSOR" + (with-temp-buffer + (my-call-process-with-torsocks no-tor "wget" nil '(t nil) nil "-O" "-" url) + (call-interactively 'delete-trailing-whitespace) + (funcall buffer-processor) + )) + +(defun my-wget-dom (url &optional no-tor) + (my-wget-out-internal + url + (lambda () (libxml-parse-html-region (point-min) (point-max))) + no-tor)) + +(defun my-wget-raw (url &optional no-tor) + (my-wget-out-internal url 'buffer-string no-tor)) + (provide 'my-wget) ;;; my-wget.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el index b3b1cf7..7cdda43 100644 --- a/emacs/.emacs.d/lisp/my/my-ytdl.el +++ b/emacs/.emacs.d/lisp/my/my-ytdl.el @@ -26,6 +26,7 @@ ;;; Code: +(require 'tor) (defvar my-ytdl-program "yt-dlp") @@ -60,21 +61,34 @@ ;; "%(id)s.%(ext)s" ;; for long names "%(playlist|.)s/%(playlist_index|)s%(playlist_index&-|)s%(title)s.%(ext)s" "--write-description" + "--write-info-json" "--write-thumbnail")) (defvar my-ytdl-audio-download-dir "~/Downloads" "Directory for ytdl to download audios to.") +(defvar my-ytdl-music-download-dir "~/Downloads" + "Directory for ytdl to download music to.") + (defun my-ytdl-internal (urls type &optional no-tor) - (my-with-default-directory (if (eq type 'video) - my-ytdl-video-download-dir - my-ytdl-audio-download-dir) - (apply 'my-start-process-with-torsocks - (append - (list no-tor (format "ytdl-%s" urls) (format "*ytdl-%s*" urls) - my-ytdl-program) - (if (eq type 'video) my-ytdl-video-args my-ytdl-audio-args) - (split-string urls))))) + (my-with-default-directory (pcase type + ('video my-ytdl-video-download-dir) + ('audio my-ytdl-audio-download-dir) + ('music my-ytdl-music-download-dir) + (_ (error "Unsupported type: %s" type))) + (set-process-sentinel + (apply 'my-start-process-with-torsocks + (append + (list no-tor (format "ytdl-%s" urls) (format "*ytdl-%s*" urls) + my-ytdl-program) + (if (eq type 'video) my-ytdl-video-args my-ytdl-audio-args) + (split-string urls))) + (lambda (proc event) + (let ((status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "ytdl-%s %s: DONE" type urls)) + (message "ytdl-%s %s FAILED: %s" type urls event))))))) (defun my-ytdl-video-info (url) "Given a video URL, return an alist of its properties." @@ -91,7 +105,7 @@ (defun my-ytdl-video-url-p (url) (let ((urlobj (url-generic-parse-url url))) (or (and (string-match-p - "^\\(www\\.\\)?\\(youtube\\.com\\|yewtu\\.be\\)" + "^\\(www\\.\\|m\\.\\)?\\(youtube\\.com\\|yewtu\\.be\\)" (url-host urlobj)) (string-match-p "^/watch\\?v=.*" (url-filename urlobj))) (equal "youtu.be" (url-host urlobj))))) @@ -148,11 +162,21 @@ (interactive "sURL(s): ") (my-ytdl-internal urls 'audio)) +(defun my-ytdl-music (urls) + "Download music with ytdl." + (interactive "sURL(s): ") + (my-ytdl-internal urls 'music)) + (defun my-ytdl-audio-no-tor (urls) "Download audio with ytdl." (interactive "sURL(s): ") (my-ytdl-internal urls 'audio t)) +(defun my-ytdl-music-no-tor (urls) + "Download music with ytdl." + (interactive "sURL(s): ") + (my-ytdl-internal urls 'music t)) + ;;; fixme: autoload (defun my-ytdl-video-no-tor (urls) "Download videos with ytdl." diff --git a/emacs/.emacs.d/lisp/my/tor.el b/emacs/.emacs.d/lisp/my/tor.el new file mode 100644 index 0000000..9ed7d5f --- /dev/null +++ b/emacs/.emacs.d/lisp/my/tor.el @@ -0,0 +1,57 @@ +;;; tor.el -- tor utilities -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "30.1")) + +;; 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: + +;; tor utilities. + +;;; Code: + + +(defun my-call-process-with-torsocks (no-tor program + &optional infile destination display + &rest args) + (if no-tor + (apply 'call-process + (append (list program infile destination display) args)) + (apply 'call-process + (append (list "torsocks" infile destination display program) args)))) + +(defun my-start-process-with-torsocks (no-tor name buffer program + &rest program-args) + (if no-tor + (apply 'start-process (append (list name buffer program) program-args)) + (apply 'start-process + (append (list name buffer "torsocks" program) program-args)))) + +(defun tor-parse-check-dom (dom) + (let ((content (dom-by-class dom "content"))) + (format "%s\n%s" + (string-trim (dom-text (dom-by-tag content 'h1))) + (string-trim (dom-texts (car (dom-by-tag content 'p))))))) + +(defun tor-check (&optional no-tor) + (require 'my-wget) + (tor-parse-check-dom (my-wget-dom "https://check.torproject.org/" no-tor))) + +(provide 'tor) +;;; tor.el ends here |