aboutsummaryrefslogtreecommitdiff
path: root/emacs/.emacs.d/lisp/my
diff options
context:
space:
mode:
Diffstat (limited to 'emacs/.emacs.d/lisp/my')
-rw-r--r--emacs/.emacs.d/lisp/my/belf.el219
-rw-r--r--emacs/.emacs.d/lisp/my/infobox.el5
-rw-r--r--emacs/.emacs.d/lisp/my/my-consult-recoll.el3
-rw-r--r--emacs/.emacs.d/lisp/my/my-editing.el29
-rw-r--r--emacs/.emacs.d/lisp/my/my-emms.el184
-rw-r--r--emacs/.emacs.d/lisp/my/my-epub.el75
-rw-r--r--emacs/.emacs.d/lisp/my/my-libgen.el176
-rw-r--r--emacs/.emacs.d/lisp/my/my-net.el1
-rw-r--r--emacs/.emacs.d/lisp/my/my-nov.el114
-rw-r--r--emacs/.emacs.d/lisp/my/my-org-remark.el65
-rw-r--r--emacs/.emacs.d/lisp/my/my-org.el67
-rw-r--r--emacs/.emacs.d/lisp/my/my-utils.el7
-rw-r--r--emacs/.emacs.d/lisp/my/my-web.el28
-rw-r--r--emacs/.emacs.d/lisp/my/my-wget.el33
14 files changed, 928 insertions, 78 deletions
diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el
index e0d89b0..0db79f6 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
@@ -41,6 +42,8 @@
"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
)
@@ -63,13 +66,18 @@
(belf-list-refresh-contents))
(pop-to-buffer-same-window buf)))
+(defun belf-library (dir)
+ (interactive (list (read-directory-name "Book directory: " belf-dir nil t)))
+ (setq belf-dir dir)
+ (belf))
+
(defun belf-list-refresh-contents (&rest _)
(setq-local tabulated-list-entries (belf-parse-all-file-names))
(tabulated-list-print))
(defvar belf-dir "~/Documents" "Directory of books.")
-(defun belf-parse-all-file-names ()
+(defun belf-parse-file-names (file-names)
(seq-filter
#'identity
(seq-map
@@ -77,9 +85,12 @@
(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\\)$"))))
+ file-names)))
-(defun belf-fix-file-name (file-name)
+(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.
@@ -114,18 +125,73 @@ foo bar & quux, baf"
((string-suffix-p ", A" title)
(concat "A " (string-remove-suffix ", A" title)))
(t title))))
- (format "%s.%s" (belf-format-base-name parsed) (alist-get 'ext parsed))))
+ (format "%s.%s"
+ (belf-format-base-name parsed new-dir)
+ (alist-get 'ext parsed))))
-(defun belf-fix-rename-file (file-name)
- (when-let ((new-name (belf-fix-file-name file-name)))
+(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-fix-rename-files ()
+(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 belf-dir t directory-files-no-dot-files-regexp))
- (belf-fix-rename-file 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)))
@@ -136,11 +202,13 @@ foo bar & quux, baf"
(identifier . ,(match-string 4 fn))
(ext . ,(match-string 5 fn))))))
-(defun belf-format-base-name (info)
+(defun belf-format-base-name (info &optional dir)
(let-alist info
(file-name-concat
- (expand-file-name belf-dir)
- (format "%s - %s (%s) [%s]" .authors .title .year .identifier))))
+ (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)
@@ -160,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)
@@ -270,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)))))
@@ -315,9 +375,9 @@ Compare without leading \"The \"."
(setf (alist-get 'Title info)
(concat (alist-get 'Title info)
" -- "
- (buttonize
- "xdg-open"
- (lambda (_) (call-process "xdg-open" nil 0 nil file-name)))
+ (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)
@@ -366,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/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el
index 0e5e054..ff4adb6 100644
--- a/emacs/.emacs.d/lisp/my/infobox.el
+++ b/emacs/.emacs.d/lisp/my/infobox.el
@@ -171,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-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 cdbe57a..e8be5ee 100644
--- a/emacs/.emacs.d/lisp/my/my-emms.el
+++ b/emacs/.emacs.d/lisp/my/my-emms.el
@@ -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-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el
index f3d6073..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,13 +162,66 @@
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))
+ (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)))
+ (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)
- (format "%s/%s" (expand-file-name my-libgen-download-dir)
- (my-libgen-format-filename info)))))
+ filename
+ nil
+ (lambda () (my-libgen-check-md5 filename md5)))))
(defun my-libgen-download-onion-action ()
(interactive)
@@ -184,14 +239,23 @@
(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: ")
@@ -217,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"
@@ -227,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 816afc6..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")
@@ -76,5 +92,101 @@ chapter title."
(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 21b227d..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,14 +216,33 @@ 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"
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))
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-06 12:03:08 +0000