diff options
Diffstat (limited to 'emacs/.emacs.d')
31 files changed, 1407 insertions, 92 deletions
diff --git a/emacs/.emacs.d/init.el b/emacs/.emacs.d/init.el index 2d229b9..e066568 100644 --- a/emacs/.emacs.d/init.el +++ b/emacs/.emacs.d/init.el @@ -53,6 +53,7 @@ (require 'ycp-web) (require 'ycp-time) (require 'ycp-markup) +(require 'ycp-reading) (require 'ycp-pdf) (require 'ycp-project) (require 'ycp-org) diff --git a/emacs/.emacs.d/init/ycp-complete.el b/emacs/.emacs.d/init/ycp-complete.el index 2caca0a..2f2117d 100644 --- a/emacs/.emacs.d/init/ycp-complete.el +++ b/emacs/.emacs.d/init/ycp-complete.el @@ -291,6 +291,9 @@ (my-package consult-recoll (:delay 30) (:install t) + (add-to-list 'consult-recoll-open-fns + '("application/pdf" . my-consult-recoll-open-in-pdf-tools)) + (setq consult-recoll-inline-snippets t) ) (my-package hmm diff --git a/emacs/.emacs.d/init/ycp-editing.el b/emacs/.emacs.d/init/ycp-editing.el index d497f42..031ae31 100644 --- a/emacs/.emacs.d/init/ycp-editing.el +++ b/emacs/.emacs.d/init/ycp-editing.el @@ -31,7 +31,10 @@ (setq-default truncate-lines nil) (setq kill-do-not-save-duplicates t) (setq kill-transform-function - (lambda (s) (when (string-match-p "[^ \t\n]" s) s))) + (lambda (s) (when (or + (derived-mode-p 'pdf-view-mode) + (string-match-p "[^ \t\n]" s)) + s))) (setq bidi-inhibit-bpa t) (setq save-interprogram-paste-before-kill t) (setq kill-ring-max 200) diff --git a/emacs/.emacs.d/init/ycp-emms.el b/emacs/.emacs.d/init/ycp-emms.el index b2e8382..e49209f 100644 --- a/emacs/.emacs.d/init/ycp-emms.el +++ b/emacs/.emacs.d/init/ycp-emms.el @@ -34,6 +34,7 @@ (emms-all) (setq emms-playing-time-resume-from-last-played t) (add-to-list 'emms-info-functions 'emms-info-ytdl) + (add-to-list 'emms-info-functions 'my-emms-info-ffprobe) ;; emms-info-native is not very useful (delete 'emms-info-native emms-info-functions) (setq emms-source-file-default-directory (locate-user-emacs-file "emms")) @@ -46,6 +47,7 @@ (setq emms-source-file-directory-tree-function 'emms-source-file-directory-tree-find) (setq emms-info-ytdl-using-torsocks t) + (setq emms-info-auto-update nil) (add-hook 'emms-playlist-mode-hook #'hl-line-mode) (add-hook 'emms-metaplaylist-mode-hook #'hl-line-mode) ) @@ -81,8 +83,8 @@ "C-<return>" #'my-emms-playlist-mode-make-current "w" #'my-emms-playlist-kill-track-name-at-point "D" #'my-emms-playlist-delete-at-point - "R" #'my-emms-playlist-random-album - "N" #'my-emms-next-track-or-random-album + "R" #'my-emms-playlist-random-group + "N" #'my-emms-next-track-or-random-group ) (add-hook 'emms-player-started-hook 'my-emms-maybe-seek-to-last-played) (my-override emms-mode-line-enable) @@ -92,12 +94,17 @@ 'my-emms-output-current-track-to-i3bar-file) (add-hook 'emms-player-finished-hook 'my-emms-score-up-playing) (add-hook 'emms-player-started-hook 'my-emms-score-up-chosen-bonus) - (setq emms-player-next-function 'my-emms-next-track-or-random-album) + (add-hook 'emms-player-started-hook 'my-emms-playlist-maybe-mark-bounds) + (add-hook 'emms-player-started-hook 'my-emms-maybe-get-duration-for-current-track) + (setq emms-player-next-function 'my-emms-next-track-or-random-group) (setq emms-players-preference-f 'my-emms-players-preference) (my-keybind dired-mode-map "e" #'my-dired-add-to-emms) (my-override emms-track-simple-description) (my-emms-add-all) (my-timer emms-save-scores-timer nil 900 'emms-score-save-hash) + (my-override emms-mode-line-playlist-current) + (my-override emms-score-show-playing) + ;; (my-override emms-playing-time-mode-line) ) (provide 'ycp-emms) diff --git a/emacs/.emacs.d/init/ycp-grep.el b/emacs/.emacs.d/init/ycp-grep.el index 85f15cd..f0ef8ce 100644 --- a/emacs/.emacs.d/init/ycp-grep.el +++ b/emacs/.emacs.d/init/ycp-grep.el @@ -107,6 +107,7 @@ ;;; org-recoll (my-package org-recoll (:delay 60) + (my-override org-recoll-format-results) (my-keybind org-recoll-mode-map "n" #'org-next-visible-heading "p" #'org-previous-visible-heading diff --git a/emacs/.emacs.d/init/ycp-markup.el b/emacs/.emacs.d/init/ycp-markup.el index 5f21da7..c90dc6a 100644 --- a/emacs/.emacs.d/init/ycp-markup.el +++ b/emacs/.emacs.d/init/ycp-markup.el @@ -107,13 +107,15 @@ (add-hook 'nov-mode-hook 'visual-line-mode) (add-hook 'nov-mode-hook 'follow-mode) (add-hook 'nov-mode-hook (lambda () - (setq next-screen-context-lines 4))) + (setq line-spacing .1))) (add-hook 'nov-post-html-render-hook 'my-nov-set-margins) (require 'my-nov) (my-override nov-render-title) (my-override nov-scroll-up) (my-keybind nov-mode-map - "Q" #'my-nov-copy-buffer-file-with-staging) + "Q" #'my-nov-copy-buffer-file-with-staging + "i" #'imenu) + (add-to-list 'nov-shr-rendering-functions '(span . my-nov-render-span)) ) ;;; json-mode diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el index 6385a46..001dbe0 100644 --- a/emacs/.emacs.d/init/ycp-org.el +++ b/emacs/.emacs.d/init/ycp-org.el @@ -306,6 +306,7 @@ (setq org-clock-idle-time 15) (setq org-clock-mode-line-total 'auto) (setq org-clock-persist 'history) + (setq org-clock-continuously t) (org-clock-persistence-insinuate)) (my-package org-refile @@ -450,7 +451,7 @@ ;; org man links (my-package ol-man (:delay 30) - (setq org-man-command 'woman)) + (setq org-man-command 'man)) (my-package ol (:delay 10) @@ -528,6 +529,9 @@ (require 'my-org-remark) (setq org-remark-notes-display-buffer-action '(display-buffer-reuse-mode-window)) + (setq org-remark-notes-file-name + (locate-user-emacs-file "margin.org")) + (my-override org-remark-highlight-add-or-update-highlight-headline) (require 'nov) (my-keybind nov-mode-map "M-n" #'org-remark-next diff --git a/emacs/.emacs.d/init/ycp-prog.el b/emacs/.emacs.d/init/ycp-prog.el index 3209e81..6584491 100644 --- a/emacs/.emacs.d/init/ycp-prog.el +++ b/emacs/.emacs.d/init/ycp-prog.el @@ -550,7 +550,8 @@ ;;; nxml (my-package nxml-mode (:delay 60) - (setq nxml-slash-auto-complete-flag t)) + (setq nxml-slash-auto-complete-flag t) + (add-to-list 'auto-mode-alist '("\\.opf\\'" . nxml-mode))) (my-package etags (:delay 60) diff --git a/emacs/.emacs.d/init/ycp-reading.el b/emacs/.emacs.d/init/ycp-reading.el new file mode 100644 index 0000000..5c0284e --- /dev/null +++ b/emacs/.emacs.d/init/ycp-reading.el @@ -0,0 +1,34 @@ +;;; ycp-reading.el -- Reading related customisation -*- 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: + +;; Reading related customisation. + +;;; Code: + +(my-package belf + (my-setq-from-local belf-dir belf-locate-dirs) + (add-hook 'find-file-hook 'belf-recent-add-current) + (blink-cursor-mode 0)) + +(provide 'ycp-reading) diff --git a/emacs/.emacs.d/init/ycp-theme.el b/emacs/.emacs.d/init/ycp-theme.el index ee76311..c6721ed 100644 --- a/emacs/.emacs.d/init/ycp-theme.el +++ b/emacs/.emacs.d/init/ycp-theme.el @@ -41,6 +41,7 @@ 'normal :weight 'normal :height 150 :width 'normal) (set-face-attribute 'fixed-pitch nil :family "Ubuntu Mono" :foundry "DAMA" :slant 'normal :weight 'normal :height 150 :width 'normal) +(set-face-attribute 'variable-pitch nil :family "Ubuntu" :foundry "DAMA") (provide 'ycp-theme) ;;; ycp-theme.el ends here diff --git a/emacs/.emacs.d/init/ycp-time.el b/emacs/.emacs.d/init/ycp-time.el index f98a9cd..f21061c 100644 --- a/emacs/.emacs.d/init/ycp-time.el +++ b/emacs/.emacs.d/init/ycp-time.el @@ -83,7 +83,7 @@ (holiday-fixed 1 26 "Australia Day (Vic holiday)") (holiday-float 3 1 2 "Labour Day (Vic holiday)") (holiday-fixed 4 25 "Anzac Day (Vic holiday)") - (holiday-float 6 1 2 "Monarch's Birthday (Vic oliday)") + (holiday-float 6 1 2 "Monarch's Birthday (Vic holiday)") (holiday-fixed 6 30 "End of financial year") (holiday-float 9 5 -1 "(Possibly) Friday before the AFL Grand Final (Vic holiday)") (holiday-float 10 5 1 "(Possibly) Friday before the AFL Grand Final (Vic holiday)") @@ -123,7 +123,7 @@ (setq appt-display-interval 5) ;; dbus notification of appt (require 'my-time) - (setq appt-disp-window-function #'my-app-display-window) + (setq appt-disp-window-function #'my-appt-display-window) ;; with org-agenda-to-appt (require 'org-clock) (require 'my-utils) diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el index 3c033ad..67c5e5a 100644 --- a/emacs/.emacs.d/init/ycp-web.el +++ b/emacs/.emacs.d/init/ycp-web.el @@ -252,6 +252,7 @@ (my-package my-web (:delay 60) + (my-setq-from-local my-webpage-download-dir) (my-keybind eww-mode-map "N" #'my-eww-next-path "P" #'my-eww-prev-path @@ -265,7 +266,8 @@ . ,(lambda (url &rest _) (my-open-newscorp-au url)))) (add-to-list 'browse-url-handlers `("^https?://www.spectator.com.au\\>" . - ,(lambda (url &rest _) (my-fetch-browse-as-googlebot url)))) ) + ,(lambda (url &rest _) (my-fetch-browse-as-googlebot url)))) + (my-setq-from-local my-firefox-profile-dir)) (my-package my-gitlab (:delay 60) @@ -357,6 +359,7 @@ (require 'my-utils) (my-setq-from-local my-libgen-hosts my-libgen-alt-hosts my-libgen-library-hosts my-libgen-onion-host + my-libgen-plus-host ) (setq my-libgen-download-dir my-document-incoming-dir my-libfic-download-dir my-document-incoming-dir) diff --git a/emacs/.emacs.d/lisp/magit-annex b/emacs/.emacs.d/lisp/magit-annex -Subproject 018e8eebd2b1e56e9e8c152c6fb249f4de52e2d +Subproject 9db0bc61461f222106c7ae3d8cd6d3de1f1b143 diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el new file mode 100644 index 0000000..0db79f6 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/belf.el @@ -0,0 +1,536 @@ +;;; 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) +(require 'my-epub) + +(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-file-names (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))))) + 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. + +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 ((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) + "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-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))) + (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-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)) + (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 dir)) + (dolist (file (directory-files 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 "context" + (lambda (_) + (funcall my-file-context-function 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))) + +;;; 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/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el index 5698042..ff4adb6 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) @@ -162,9 +171,4 @@ something like (lambda (line) (string-match-p "^[0-9]" line)) (split-string (buffer-string) "\n")))) -(defun my-call-process-out (command &rest args) - (with-temp-buffer - (apply 'call-process (append (list command nil t nil) args)) - (buffer-string))) - (provide 'infobox) diff --git a/emacs/.emacs.d/lisp/my/my-consult-recoll.el b/emacs/.emacs.d/lisp/my/my-consult-recoll.el new file mode 100644 index 0000000..1754ad4 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-consult-recoll.el @@ -0,0 +1,3 @@ +(defun my-consult-recoll-open-in-pdf-tools (filename &optional page) + (find-file filename) + (when page (pdf-view-goto-page page))) 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-editing.el b/emacs/.emacs.d/lisp/my/my-editing.el index 0775063..e6499ff 100644 --- a/emacs/.emacs.d/lisp/my/my-editing.el +++ b/emacs/.emacs.d/lisp/my/my-editing.el @@ -528,7 +528,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 +546,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 (> 1 (count-lines b (min (1+ e) (point-max)))) + (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 e3e4d32..e8be5ee 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,142 @@ 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)) + (maybe-group-end (+ group-start my-emms-playlist-group-length)) + (group-end + (if (<= (- end-ln maybe-group-end) my-emms-playlist-tail-group-length) + end-ln + (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 + (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) + (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 @@ -495,12 +625,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. @@ -513,14 +653,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..4a3dfca --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-epub.el @@ -0,0 +1,75 @@ +;;; 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) + )) + )) + +(provide 'my-epub) +;;; my-epub.el ends here 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..d4efb30 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,68 @@ 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)) + (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-get-download-url info) + filename + nil + (lambda () (my-libgen-check-md5 filename md5))))) + +(defun my-libgen-plus-edition-infobox (edition-id) + (let ((dom (my-url-fetch-dom + (format "%s/edition.php?id=%s" my-libgen-plus-host edition-id)))) + (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 ,edition-id) + (called-interactively-p 'interactive) + ) + )) + +(defun my-libgen-plus-infobox-action () + (interactive) + (my-libgen-plus-edition-infobox + (alist-get 'edition-id (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) + (warn "MD5 checksum of %s mismatch: should be %s but actually %s" + file md5 actual)))) + +(defun my-libgen-download-library-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-make-download-link-library info) + filename + nil + (lambda () (my-libgen-check-md5 filename md5))))) + +(defun my-libgen-download-onion-action () (interactive) (let ((info (get-text-property (point) 'button-data))) (my-wget-async @@ -171,18 +234,28 @@ (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 "i" 'my-libgen-plus-infobox-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 +281,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 +319,72 @@ (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) + (when as + (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-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))) + (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 (when mirrors (my-libgen-plus-guess-md5 mirrors))) + ) + `((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-net.el b/emacs/.emacs.d/lisp/my/my-net.el index 6212b50..b19ce68 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-download-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 1bc8eca..d43a8f3 100644 --- a/emacs/.emacs.d/lisp/my/my-nov.el +++ b/emacs/.emacs.d/lisp/my/my-nov.el @@ -41,10 +41,26 @@ chapter title." ;; this shouldn't happen for properly authored EPUBs (when (not title) (setq title "No title")) + ;; TODO: fix mode line update (setq mode-line-buffer-identification - (concat title ": " chapter-title)) + (format "%s: %s (%d%%)" + title chapter-title + (/ (* 100 (my-nov-word-position)) my-nov-total-word-count) + )) )) +(defun my-nov-render-span (dom) + (unless (equal (dom-attr dom 'epub:type) "pagebreak") + (shr-generic dom))) + +(defun my-nov-find-file-with-ipath (file-name ipath) + "Find epub file and goto IPATH. + +Useful for recoll." + (find-file file-name) + (unless (derived-mode-p 'nov-mode) (nov-mode)) + (nov-goto-document (nov-find-document (lambda (p) (eq ipath (car p)))))) + (defun my-nov-scroll-up (arg) "Scroll with `scroll-up' or visit next chapter if at bottom." (interactive "P") @@ -65,8 +81,112 @@ 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) + ) + +(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 the beginning of the +screen." + (my-nov-count-words) + (let ((result 0)) + (dotimes (i nov-documents-index) + (setq result (+ result (cdr (aref my-nov-document-word-counts i))))) + (save-excursion + (move-to-window-line 0) + (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 5d7203f..e628c5b 100644 --- a/emacs/.emacs.d/lisp/my/my-org.el +++ b/emacs/.emacs.d/lisp/my/my-org.el @@ -1155,21 +1155,47 @@ On success, also move everything from staging to to-dir." (require 'org-recoll) "Format recoll results in buffer." ;; Format results in org format and tidy up - (org-recoll-regexp-replace-in-buffer - "^.*?\\[\\(.*?\\)\\]\\s-*\\[\\(.*?\\)\\]\\(.*\\)$" - "* [[\\1][\\2]] <\\1>\\3") - (org-recoll-regexp-replace-in-buffer - (format "<file://.*?%s\\(.*/\\).*>" (substring my-docs-root-dir 1)) - "(\\1)") + (org-recoll-regexp-replace-in-buffer "file://" "file:") + (goto-char (point-min)) + (delete-trailing-whitespace) + (while (re-search-forward + "^.*?\\[\\(.*?\\)\\]\\s-*\\[\\(.*?\\)\\]\\(.*\\)$" nil t) + (let ((file-name (match-string 1)) + (title (match-string 2)) + (size (match-string 3))) + (replace-match + (format "* %s (%s)%s" + (org-link-make-string file-name title) + (file-name-nondirectory file-name) + size) + t + t))) (org-recoll-regexp-replace-in-buffer "\\/ABSTRACT" "") (org-recoll-regexp-replace-in-buffer "ABSTRACT" "") ;; Justify results (goto-char (point-min)) (org-recoll-fill-region-paragraphs) ;; Add emphasis - (highlight-phrase (org-recoll-reformat-for-file-search - org-recoll-search-query) - 'bold-italic)) + (let ((search-whitespace-regexp "[ ]+")) + (highlight-phrase (org-recoll-reformat-for-file-search + org-recoll-search-query) + 'bold-italic))) + +(defun my-org-recoll-query (query) + ;; caddr contains number of results + (seq-map + (lambda (line) + (pcase-let ((`(,title ,filename ,ipath ,abstract) + (seq-map 'base64-decode-string (split-string line " ")))) + `((title . ,title) + (filename . ,filename) + (ipath . ,ipath) + (abstract . ,abstract)))) + (cdddr + (string-lines + (my-call-process-out + "recollq" "-F" "title filename ipath abstract" "-n" "0-40" "-q" query)))) + ) (defun my-org-recoll-mdn (query) (interactive "sSearch mdn: ") @@ -1636,5 +1662,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-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el index 3ecd0a9..0743227 100644 --- a/emacs/.emacs.d/lisp/my/my-utils.el +++ b/emacs/.emacs.d/lisp/my/my-utils.el @@ -304,6 +304,13 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" ,@body (setq default-directory saved))) + +(defun my-call-process-out (command &rest args) + "Call `call-process' on COMMAND with ARGS and return the output." + (with-temp-buffer + (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 diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el index 3d1f9d3..7c9c567 100644 --- a/emacs/.emacs.d/lisp/my/my-web.el +++ b/emacs/.emacs.d/lisp/my/my-web.el @@ -146,10 +146,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-download-dir) (expand-file-name (my-make-file-name-from-url url "html") - my-download-dir)))) + my-webpage-download-dir)))) (url-copy-file url file-name (not no-overwrite)) (browse-url-firefox (format "file://%s" file-name)))) @@ -163,6 +163,7 @@ Useful for bypassing some paywalls." (require 'hmm) (defvar my-url-context-function 'hmm-url "Context function for urls.") +(defvar my-file-context-function 'hmm-file "Context function for files.") (defun my-hacker-news-url-p (url) "Check if a url is a hacker news post. @@ -215,13 +216,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 diff --git a/emacs/.emacs.d/lisp/my/my-wget.el b/emacs/.emacs.d/lisp/my/my-wget.el index 5349257..e7283aa 100644 --- a/emacs/.emacs.d/lisp/my/my-wget.el +++ b/emacs/.emacs.d/lisp/my/my-wget.el @@ -48,20 +48,31 @@ (kill-new full-path) (message "Saved webpage to %s (path copied)." full-path))) -(defun my-wget-async (url filename &optional no-tor move-if-video-or-large) +(defun my-wget-async (url filename &optional no-tor on-success on-fail) (set-process-sentinel (my-start-process-with-torsocks no-tor "wget" "*wget*" "wget" url "-c" "-O" filename) - (lambda (_process _event) - (when (and move-if-video-or-large - (or - (> (file-attribute-size (file-attributes filename)) - my-wget-size-threshold) - (member (file-name-extension filename) my-wget-video-extensions))) - (setq filename - (my-rename-and-symlink-back - filename (expand-file-name my-wget-video-archive-directory) nil))) - (message "Fetched %s and saved to: %s" url filename)))) + (lambda (proc event) + (let ((ps (process-status proc)) + (status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "[DONE] Fetched %s to %s" url filename) + (when on-success (funcall on-success))) + (message "[FAIL] Fetching %s to %s: %s" url filename event) + (when on-fail (funcall on-fail)))) + ) + )) + +(defun my-wget-move-if-video-or-large (url filename _process _event) + (when (or + (> (file-attribute-size (file-attributes filename)) + my-wget-size-threshold) + (member (file-name-extension filename) my-wget-video-extensions)) + (setq filename + (my-rename-and-symlink-back + filename (expand-file-name my-wget-video-archive-directory) nil))) + (message "Fetched %s and saved to: %s" url filename)) (defun wget-async-urls-with-prefix (urls prefix &optional no-tor move-if-video-or-large) (let ((i 1)) |