diff options
Diffstat (limited to 'emacs/.emacs.d/lisp')
23 files changed, 849 insertions, 77 deletions
diff --git a/emacs/.emacs.d/lisp/exitter b/emacs/.emacs.d/lisp/exitter -Subproject cdcda7feb9a5b9a4530be09149537217148b848 +Subproject e0aa1eb8b5dd2696f92f90348cb9e8aedd79800 diff --git a/emacs/.emacs.d/lisp/hmm.el b/emacs/.emacs.d/lisp/hmm.el -Subproject 2157ead39273691013c38529b14953ea839c2a5 +Subproject a0660da71f9aef8909973e9fd44b5eb34db0386 diff --git a/emacs/.emacs.d/lisp/mastodon.el b/emacs/.emacs.d/lisp/mastodon.el -Subproject d8ef4fff34862ff3cef76ea704b8c4c6c7d7508 +Subproject dbb1e5ef4473c418b164b4c74c44cf8ac95e4eb diff --git a/emacs/.emacs.d/lisp/my/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el new file mode 100644 index 0000000..518c7db --- /dev/null +++ b/emacs/.emacs.d/lisp/my/infobox.el @@ -0,0 +1,145 @@ +;;; infobox.el -- Infobox in a help buffer -*- 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: + +;; Infobox in a help buffer. + +;;; Code: + + +(defun infobox-default-specs (info) + (seq-map + (lambda (pair) + (cons (car pair) + (replace-regexp-in-string + "[-_]" " " + (capitalize (format "%s" (car pair)))))) + info)) + +(defun infobox-translate (info specs) + "Translate INFO according to SPECS. + +TODO: allow multiple levels in specs keys using let-alist, i.e. +something like + +(.channel.name . \"Channel name\")" + (seq-map + (lambda (pair) + (when-let ((val (alist-get (car pair) info))) + (if (or (stringp (cdr pair)) (symbolp (cdr pair))) + (cons (cdr pair) val) + (cons (cadr pair) (funcall (cddr pair) val))))) + specs)) + +(defun infobox-render (info item &optional interactive-p) + "Render and display a help buffer of INFO." + (with-help-window "*infobox*" + (with-current-buffer standard-output + (let ((n-rows 0)) + (seq-do + (lambda (pair) + (when pair + (when (stringp (car pair)) + (insert (car pair) ": ") + (setq n-rows (1+ n-rows))) + (insert (format "%s" (cdr pair)) "\n"))) + info) + (align-regexp + (point-min) + (progn (goto-line (1+ n-rows)) (point)) + "\\(\\s-*\\):")) + (visual-line-mode))) + (with-current-buffer "*infobox*" + (let ((help-xref-following t)) + (help-setup-xref item interactive-p) + ))) + +(defun infobox-render-string (text item &optional interactive-p) + (help-setup-xref item interactive-p) + (with-help-window "*infobox*" + (with-current-buffer standard-output + (insert text) + (visual-line-mode))) + (with-current-buffer "*infobox*" + (let ((help-xref-following t)) + (help-setup-xref item interactive-p) + ))) + +(defun infobox-exiftool (filename) + (interactive (list (expand-file-name (read-file-name "infobox exiftool: ")))) + (infobox-render-string + (with-temp-buffer + (call-process "exiftool" nil t nil filename) + (buffer-string)) + `(infobox-exiftool ,filename) + (called-interactively-p 'interactive) + )) + +(defun infobox-pacman (package-name) + (interactive (list (completing-read + "pacman package: " + (infobox-pacman-installed-packages) + nil + t))) + (infobox-render-string + (with-temp-buffer + (call-process "pacman" nil t nil "-Qi" package-name) + (buffer-string)) + `(infobox-pacman ,package-name) + (called-interactively-p 'interactive) + )) + +(defun infobox-pacman-installed-packages () + "Returns list of installed packages." + (with-temp-buffer + (call-process "pacman" nil t nil "-Qq") + (split-string (buffer-string) "\n"))) + +(defun infobox-calibre (book-id) + (interactive (list (car (split-string + (completing-read + "calibre book: " + (infobox-calibre-books) + nil + t) + " ")))) + (infobox-render-string + (with-temp-buffer + (call-process "calibredb" nil t nil "show_metadata" book-id) + (buffer-string)) + `(infobox-calibre ,book-id) + (called-interactively-p 'interactive))) + +(defun infobox-calibre-books () + (with-temp-buffer + (call-process "calibredb" nil t nil "list") + (seq-filter + (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-buffer.el b/emacs/.emacs.d/lisp/my/my-buffer.el index f06956f..f2da7f5 100644 --- a/emacs/.emacs.d/lisp/my/my-buffer.el +++ b/emacs/.emacs.d/lisp/my/my-buffer.el @@ -239,24 +239,54 @@ that point." (setq buffer temp-buffer)) (set-window-buffer first-window buffer))) +(defun my-set-left-buffer () + "Generate and switch to an empty buffer." + (interactive) + (set-window-buffer + (window-left (get-buffer-window)) + (with-current-buffer (get-buffer-create "*my-left*") + (read-only-mode t) + (current-buffer)))) + +(defun my-set-right-buffer () + "Generate and switch to an empty buffer." + (interactive) + (set-window-buffer + (window-right (get-buffer-window)) + (with-current-buffer (get-buffer-create "*my-right*") + (read-only-mode t) + (current-buffer)))) + (defun my-toggle-focus-write () "Toggle focus write mode. Focus write: make the current window the only one centered with -width 80. If in org-mode, also narrow to current subtree." +width 80. If in org-mode, also narrow to current subtree. Make +buffers on both sides empty read-only buffers." (interactive) ;; Only one window in the current frame indicates we are in focus ;; write mode. - (if (length= (window-list) 1) + (if (and (equal + (buffer-name + (window-buffer (window-left (get-buffer-window)))) + "*my-left*") + (equal + (buffer-name + (window-buffer (window-right (get-buffer-window)))) + "*my-right*")) (progn (winner-undo) (when (derived-mode-p 'org-mode) (widen))) (when (derived-mode-p 'org-mode) (org-narrow-to-subtree)) - (delete-other-windows) - (let ((margin (/ (- (window-width) 80) 2))) - (set-window-margins nil margin margin)))) + (my-set-left-buffer) + (my-set-right-buffer) + (let ((margin (/ (- 80 (window-width)) 2))) + (enlarge-window margin t) + (windmove-left) + (enlarge-window (- margin) t) + (windmove-right)))) (defun my-select-new-window-matching-mode (mode) "Select a new window." @@ -415,6 +445,11 @@ for the given MAJOR-MODE, any text is appended to it." (4 (my-buffer-scratch-setup region default-mode)) (_ (my-buffer-scratch-setup region))))) +(defun my-new-empty-buffer () + "Generate and switch to an empty buffer." + (interactive) + (switch-to-buffer (generate-new-buffer "empty"))) + (defcustom my-scratch-buffer-default-mode 'org-mode "Default major mode for `my-buffer-create-scratch'." :type 'symbol @@ -483,5 +518,15 @@ With double prefix arguments, create a new indirect buffer." (revert-buffer t t)) (switch-to-buffer buffer))) +(defun my-fontify-with-mode (text mode) + "Fontify TEXT with MODE." + (with-temp-buffer + (funcall mode) + (insert text) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (with-no-warnings (font-lock-fontify-buffer))) + (buffer-string))) + (provide 'my-buffer) ;;; my-buffer.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-emms.el b/emacs/.emacs.d/lisp/my/my-emms.el index ffb6bc0..fd3c73d 100644 --- a/emacs/.emacs.d/lisp/my/my-emms.el +++ b/emacs/.emacs.d/lisp/my/my-emms.el @@ -165,7 +165,7 @@ either 'audio or 'video (if (and (length> players 1) (string-prefix-p "file://" name) (member (file-name-extension name) - '("mkv" "mp4" "ogv" "avi" "webm"))) + '("mkv" "ogv" "avi" "webm"))) 'emms-player-vlc 'emms-player-mpv))) @@ -300,10 +300,23 @@ filter extensions from filter-exts." (defvar my-emms-i3bar-file (locate-user-emacs-file "emms-i3bar") "File to write current playing to which i3bar reads") (defun my-emms-get-display-name (track) + "Return the display name of a track. + +The display name is either the info-title, or the display name of +the filename." (or (alist-get 'info-title track) (when-let ((name (alist-get 'name track))) - (replace-regexp-in-string "^\\(.*/\\)\\(.*/.*/.*\\)" "\\2" name)))) + (my-emms-get-display-name-1 name)))) + +(defun my-emms-get-display-name-1 (name) + "Return the display name of a filename NAME. + +The display name is the last three components of the filename, +assuming the filesystem hierarchy is arranged in +artist/album/track." + (replace-regexp-in-string "^\\(.*/\\)\\(.*/.*/.*\\)" "\\2" name)) + (defun my-emms-output-current-track-to-i3bar-file () (let ((current-track (my-emms-get-display-name (emms-playlist-current-selected-track)))) @@ -473,13 +486,40 @@ Hex-encoded characters in URLs are replaced by the decoded character." (let ((type (emms-track-type track))) (cond ((emms-track-get track 'description) - (emms-track-get track 'description)) - ((eq 'file type) - (emms-track-name track)) + (emms-track-get track 'description)) + ((eq 'file type) + (emms-track-name track)) ((eq 'url type) (emms-format-url-track-name (emms-track-name track))) (t (concat (symbol-name type) ": " (emms-track-name track)))))) +(defvar my-emms-score-delta 1) + +(defun my-emms-score-up-playing () + "Increase score by `my-emms-score-delta', then reset it 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-up-chosen-bonus () + "Bonus score up if the track is started intentionally. + +If the last command is `emms-playlist-mode-play-smart', then set +`my-emms-score-delta' to 2." + (when (eq last-command 'emms-playlist-mode-play-smart) + (setq my-emms-score-delta 2))) + +(defun my-emms-wrapped () + "Print top 5 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")))) + (provide 'my-emms) ;;; my-emms.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-github.el b/emacs/.emacs.d/lisp/my/my-github.el index 45adcf6..1643612 100644 --- a/emacs/.emacs.d/lisp/my/my-github.el +++ b/emacs/.emacs.d/lisp/my/my-github.el @@ -54,6 +54,56 @@ License; name; description; homepage; created at" (cons "Developers" (my-grok-github-get-developer-name (alist-get 'url (alist-get 'owner raw)))))) +(defun my-github-api-repos (url) + (when-let* ((urlobj (url-generic-parse-url url)) + (path (url-filename urlobj)) + (project-id + (when (string-match "^/[^/]+/[^/]+" path) + (match-string 0 path)))) + (my-url-fetch-json + (format "https://api.github.com/repos%s" project-id)))) + +(defun my-github-api-readme (url) + (when-let* ((urlobj (url-generic-parse-url url)) + (path (url-filename urlobj)) + (project-id + (when (string-match "^/[^/]+/[^/]+" path) + (match-string 0 path))) + ;; so that the response of readme is in html format + (url-request-extra-headers + '(("Accept" . "application/vnd.github.html")))) + (my-url-fetch-raw + (format "https://api.github.com/repos%s/readme" project-id)))) + +(defun my-github-project-infobox (url) + (interactive "sGithub repo url: ") + (let ((info + (append + (my-github-api-repos url) + `((readme . ,(my-github-api-readme url)))))) + (infobox-render + (infobox-translate + info my-github-project-info-specs) + `(my-github-project-infobox ,url) + (called-interactively-p 'interactive))) + ) + +(defvar my-github-project-info-specs + `((html_url . "Clone") + (full_name . "Name") + (description . "Description") + (created_at . ("Created at" . my-gitlab-format-time-string)) + (pushed_at . ("Pushed at" . my-gitlab-format-time-string)) + (topics . ("Topics" . ,(lambda (xs) + (mapconcat #'identity xs "; ")))) + (stargazers_count . ("Stars" . number-to-string)) + (forks_count . ("Forks" . number-to-string)) + (readme . (body . ,(lambda (text) + (with-temp-buffer + (insert text) + (shr-render-region (point-min) (point-max)) + (buffer-string))))))) + (defun my-grok-github-get-developer-name (url) (with-current-buffer (url-retrieve-synchronously url) (set-buffer-multibyte t) diff --git a/emacs/.emacs.d/lisp/my/my-gitlab.el b/emacs/.emacs.d/lisp/my/my-gitlab.el index 6dd484c..ad7f0ed 100644 --- a/emacs/.emacs.d/lisp/my/my-gitlab.el +++ b/emacs/.emacs.d/lisp/my/my-gitlab.el @@ -26,8 +26,9 @@ ;;; Code: +(require 'infobox) -(defun my-get-gitlab-project-id (url) +(defun my-gitlab-get-project-id (url) (with-current-buffer (url-retrieve-synchronously (replace-regexp-in-string "\\.git$" "" url)) (let ((dom (libxml-parse-html-region (point-min) (point-max)))) @@ -35,16 +36,75 @@ (dom-search dom (lambda (n) (dom-attr n 'data-project-id)))) 'data-project-id)))) -(defun my-grok-gitlab (url) +(defun my-gitlab-api-projects (url) (when-let* ((urlobj (url-generic-parse-url url)) - (project-id (my-get-gitlab-project-id url))) - (with-current-buffer - (url-retrieve-synchronously - (concat (url-type urlobj) "://" (url-host urlobj) - "/api/v4/projects/" project-id)) - (set-buffer-multibyte t) - (my-delete-http-header) - (my-grok-gitlab-make-info (json-read))))) + (project-id (my-gitlab-get-project-id url))) + (my-url-fetch-json + (format "%s://%s/api/v4/projects/%s" + (url-type urlobj) + (url-host urlobj) + project-id)))) + +(defvar my-gitlab-readme-get-raw nil "Whether to get raw or html readme") + +(defun my-gitlab-project-info (url) + "Given a url, returns project info." + (let ((info (my-gitlab-api-projects url))) + (let-alist info + (when .readme_url + (setf (alist-get 'readme info) + (if my-gitlab-readme-get-raw + (format + "\n%s" + (my-url-fetch-raw + (replace-regexp-in-string "/-/blob/" "/-/raw/" .readme_url))) + (alist-get + 'html + (my-url-fetch-json + (format "%s?format=json&viewer=rich" .readme_url))))))) + info)) + +(defun my-gitlab-format-time-string (t) + (format-time-string "%Y-%m-%d %M:%M:%S" (encode-time (parse-time-string t)))) + +(defun my-gitlab-project-url-p (url) + (let ((urlobj (url-generic-parse-url url))) + (and (equal (url-host urlobj) "gitlab.com") + (string-match-p "^/[^/]+/[^/]+$" (url-filename urlobj))))) + +(require 'my-buffer) + +(defvar my-gitlab-project-info-specs + `((http_url_to_repo . "Clone") + (name_with_namespace . "Name") + (description . "Description") + (created_at . ("Created at" . my-gitlab-format-time-string)) + (last_activity_at . ("Updated at" . my-gitlab-format-time-string)) + (topics . ("Topics" . ,(lambda (xs) + (mapconcat #'identity xs "; ")))) + (star_count . ("Stars" . number-to-string)) + (forks_count . ("Forks" . number-to-string)) + (readme . (body . ,(lambda (text) + (with-temp-buffer + (insert text) + (shr-render-region (point-min) (point-max)) + (buffer-string))))))) + +(defun my-gitlab-project-infobox (url) + "Display a gitlab project info at URL in a help buffer. + +A good example would be +<https://gitlab.com/woob/woob> +" + (interactive "sGitlab project URL: ") + (infobox-render + (infobox-translate + (my-gitlab-project-info url) my-gitlab-project-info-specs) + `(my-gitlab-project-infobox ,url) + (called-interactively-p 'interactive))) + +(defun my-grok-gitlab (url) + (my-grok-gitlab-make-info (my-gitlab-api-projects url))) (defun my-grok-gitlab-make-info (raw) (list (cons "Title" (alist-get 'name raw)) diff --git a/emacs/.emacs.d/lisp/my/my-ledger.el b/emacs/.emacs.d/lisp/my/my-ledger.el new file mode 100644 index 0000000..b1ad2ca --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-ledger.el @@ -0,0 +1,52 @@ +;;; my-ledger.el -- customizations to ledger mode -*- 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: + +;; customizations to ledger mode. + +;;; Code: + + +(defun my-ledger-move-xact-down () + (interactive) + (call-interactively 'transpose-paragraphs) + (call-interactively 'ledger-navigate-prev-xact-or-directive)) + +(defun my-ledger-move-xact-up () + (interactive) + (call-interactively 'ledger-navigate-prev-xact-or-directive) + (call-interactively 'transpose-paragraphs) + (call-interactively 'ledger-navigate-prev-xact-or-directive) + (call-interactively 'ledger-navigate-prev-xact-or-directive)) + +;;; hledger: Error: /home/ycp/Documents/finance/huecu.ledger:1615:41: +(defvar my-ledger-compilation-error-re + '(ledger "^hledger: Error: \\(.+\\):\\([0-9]+\\):\\([0-9]+\\):$" 1 2 3)) + +(defun my-ledger-set-compile-command () + (setq-local + compile-command + (format "%s bal -f %s" ledger-binary-path buffer-file-name))) + +(provide 'my-ledger) +;;; my-ledger.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el index 6b65eb1..67e0071 100644 --- a/emacs/.emacs.d/lisp/my/my-libgen.el +++ b/emacs/.emacs.d/lisp/my/my-libgen.el @@ -251,5 +251,121 @@ (filesize-human . ,filesize-human) (extension . ,extension)))) +(defvar my-libfic-download-dir "~/Downloads") +(defun my-libfic-search (query) + (interactive "sQuery: ") + (generic-search-open + (mapcar 'my-libfic-search-parse-tr + (cdr + (dom-by-tag + (my-url-fetch-dom + (format "%s/fiction/?q=%s" + my-libgen-host query)) + 'tr))) + (format "libfic-query:%s" query) + `((formatter . my-libfic-search-format-result) + (default-action . my-grok-libfic-action) + (keymap . ,my-libfic-button-keymap)))) + +(defun my-libfic-search-parse-tr (tr) + (let* ((tds (dom-by-tag tr 'td)) + (author (string-trim (dom-texts (pop tds) ""))) + (series (dom-text (pop tds))) + (title-id (pop tds)) + (title-md5 (car (dom-by-tag title-id 'a))) + (title (dom-text title-md5)) + (md5 (elt (split-string (or (dom-attr title-md5 'href) "") "/") 2)) + (identifier (dom-text (dom-by-class title-id "catalog_identifier"))) + (language (dom-text (pop tds))) + (extension-filesize-human (split-string (dom-text (pop tds)) " / ")) + (extension (downcase (car extension-filesize-human))) + (filesize-human (cadr extension-filesize-human)) + ) + `((author . ,author) + (series . ,series) + (md5 . ,md5) + (title . ,title) + (identifier . ,identifier) + (language . ,language) + (filesize-human . ,filesize-human) + (extension . ,extension)))) + +(defun my-libfic-search-format-result (info) + (format + "%s [%s] %s" + (my-libfic-format-filename info) + (alist-get 'language info) + (alist-get 'filesize-human info))) + +(defun my-libfic-format-filename (info) + (replace-regexp-in-string "[:;]" "_" + (format + "%s - %s (%s) [%s].%s" + (alist-get 'author info) + (alist-get 'title info) + (alist-get 'series info) + (alist-get 'identifier info) + (alist-get 'extension info)))) + +(defun my-grok-libfic-action (info) + (interactive) + (my-org-create-node + (my-grok-libfic-make-info + (my-libfic-update-info info)) + t)) + +(defun my-libfic-update-info (info) + (when-let ((tr-id + (seq-find + (lambda (tr) + (equal "ID:" (dom-text (car (dom-by-tag tr 'td))))) + (dom-by-tag + (my-url-fetch-dom + (format "%s/fiction/%s" my-libgen-host (alist-get 'md5 info))) + 'tr)))) + `((id . ,(dom-text (cadr (dom-by-tag tr-id 'td)))) . ,info))) + +;;; todo: description; publisher; cover +(defun my-grok-libfic-make-info (info) + (list + (cons "libfic-id" (alist-get 'id info)) + (cons "Title" (alist-get 'title info)) + (cons "Series" (alist-get 'series info)) + (cons "Authors" (alist-get 'author info)) + (cons "ISBN" (alist-get 'identifier info)) + (cons "Language" (alist-get 'language info)) + (cons "Filesize-human" (alist-get 'filesize-human info)) + (cons "Extension" (alist-get 'extension info)) + (cons "md5" (alist-get 'md5 info)))) + +(defvar my-libfic-button-keymap + (let ((kmap (make-sparse-keymap))) + (set-keymap-parent kmap button-map) + (define-key kmap "d" 'my-libfic-download-action) + (define-key kmap "p" 'my-libfic-show-more-info) + kmap)) + +(defun my-libfic-show-more-info () + (interactive) + (let ((info (get-text-property (point) 'button-data))) + (pp (my-grok-libfic-make-info (my-libfic-update-info info))))) + +(defun my-libfic-download-action () + (interactive) + (let ((info (get-text-property (point) 'button-data))) + (my-wget-async + (my-libfic-make-download-link-onion + (my-libfic-update-info info)) + (format "%s/%s" (expand-file-name my-libfic-download-dir) + (my-libfic-format-filename info))))) + +(defun my-libfic-make-download-link-onion (info) + (let ((id-head (substring (alist-get 'id info) 0 -3))) + (format "%s/FF/%s%s/%s" + my-libgen-onion-host + (make-string (- 4 (length id-head)) ?0) + id-head + (downcase (alist-get 'md5 info))))) + (provide 'my-libgen) ;;; my-libgen.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-mariadb.el b/emacs/.emacs.d/lisp/my/my-mariadb.el index 6b0e06b..bdb1c60 100644 --- a/emacs/.emacs.d/lisp/my/my-mariadb.el +++ b/emacs/.emacs.d/lisp/my/my-mariadb.el @@ -251,6 +251,24 @@ enum spider_malloc_id { nil t) (tempel-insert 'ps))) +(defun my-mariadb-kb-url-p (url) + (string-match-p "https://mariadb.com/kb/en/\\([^/]+\\)/" url)) + +(defun my-wiki-mariadb-extract-kb-source () + "Extract the kb source from the current buffer. + +Used for wiki mode as a post-processor." + (let ((source + (dom-text + (dom-by-id + (libxml-parse-html-region (point-min) (point-max)) + "answer_source")))) + (erase-buffer) + (insert source)) + (goto-char (point-min)) + (save-buffer) + ) + (defun my-mariadb-fetch-kb-source (url) "Fetches the source to an maridb kb entry at URL. diff --git a/emacs/.emacs.d/lisp/my/my-net.el b/emacs/.emacs.d/lisp/my/my-net.el index 1f1cbc6..2574789 100644 --- a/emacs/.emacs.d/lisp/my/my-net.el +++ b/emacs/.emacs.d/lisp/my/my-net.el @@ -119,6 +119,14 @@ It checks the STATUS, and if it is ok, saves the payload to FILE-NAME." decompression with-header)) + +(defun my-url-fetch-raw (url &optional decompression with-header) + (my-url-fetch-internal + url + (lambda () (decode-coding-string (buffer-string) 'utf-8)) + decompression + with-header)) + (defun my-url-fetch-internal (url buffer-processor decompression with-header) (with-current-buffer (get-buffer-create my-client-buffer-name) (goto-char (point-max)) @@ -141,7 +149,7 @@ It checks the STATUS, and if it is ok, saves the payload to FILE-NAME." (list (cons 'header fields) (cons 'json (funcall buffer-processor))) - (funcall buffer-processor))) + (when buffer-processor (funcall buffer-processor)))) (error "HTTP error: %s" (buffer-substring (point) (point-max))))))) (provide 'my-net) diff --git a/emacs/.emacs.d/lisp/my/my-nov.el b/emacs/.emacs.d/lisp/my/my-nov.el index 863d09a..1bc8eca 100644 --- a/emacs/.emacs.d/lisp/my/my-nov.el +++ b/emacs/.emacs.d/lisp/my/my-nov.el @@ -52,5 +52,21 @@ chapter title." (nov-next-document) (follow-scroll-up arg))) +(defun my-nov-copy-buffer-file-with-staging () + (interactive) + (unless (derived-mode-p 'nov-mode) (error "Not in nov mode")) + (pcase-let* ((name + (completing-read (format "Copy %s to: " nov-file-name) + my-copy-file-targets + nil t)) + (`(,dest ,staging) (alist-get name my-copy-file-targets + nil nil #'equal))) + (my-copy-file-with-staging + nov-file-name dest staging))) + +(defun my-nov-set-margins () + (set-window-margins nil 3 2) + (set-window-fringes nil 0 0)) + (provide 'my-nov) ;;; my-nov.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-org-jira.el b/emacs/.emacs.d/lisp/my/my-org-jira.el index 2502f02..9e2f821 100644 --- a/emacs/.emacs.d/lisp/my/my-org-jira.el +++ b/emacs/.emacs.d/lisp/my/my-org-jira.el @@ -82,7 +82,7 @@ :proj-key (path '(fields project key)) :related-issues (mapconcat (lambda (c) - (print c) + ;; (print c) (if (org-jira-sdk-path c '(inwardIssue)) (if (equal (org-jira-sdk-path @@ -269,5 +269,13 @@ (interactive) (kill-new (my-org-jira-comment-url-at-point))) +(defun my-org-jira-url-p (url) + (string-match-p (format "^%s/browse/[^/]" jiralib-url) url)) + +(defun my-org-jira-open-url (url) + (interactive "sJIRA issue url: ") + (when (string-match (format "^%s/browse/\\([^/]+\\)" jiralib-url) url) + (org-jira-get-issue (match-string 1 url)))) + (provide 'my-org-jira) ;;; my-org-jira.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 new file mode 100644 index 0000000..3e0ef0a --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-org-remark.el @@ -0,0 +1,36 @@ +;;; my-org-remark.el -- customization to org-remark -*- 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: + +;; customization to org-remark. + +;;; Code: + +(defun my-org-remark-open-or-create () + (interactive) + (if mark-active + (call-interactively 'org-remark-mark) + (call-interactively 'org-remark-open))) + +(provide 'my-org-remark) +;;; my-org-remark.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el index ad0c3cb..5d7203f 100644 --- a/emacs/.emacs.d/lisp/my/my-org.el +++ b/emacs/.emacs.d/lisp/my/my-org.el @@ -81,7 +81,12 @@ buffer was a live window.") (defun my-org-edit-src-before-exit () "A :before advice for org-edit-src-exit." - (delete-trailing-whitespace) + (goto-char (point-min)) + (and + (>= (skip-chars-forward "\n") 1) + (region-modifiable-p (point-min) (point)) + (delete-region (point-min) (point))) + (let ((delete-trailing-lines t)) (delete-trailing-whitespace)) (setq my-org-edit-src-was-live-window (get-buffer-window (current-buffer)))) (defun my-org-element-block-p (element) @@ -812,8 +817,6 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks." (cl-letf (((symbol-function 'delete-other-windows) 'ignore)) (apply oldfun args))) -(defvar my-org-attach-copy-attached-targets nil - "Alist of targets to copy attached to, in the form of (name . path)") (defvar my-org-attach-copy-attached-doc-exts '("epub" "pdf" "mobi")) (defvar my-org-attach-copy-attached-doc-re @@ -832,44 +835,15 @@ On success, also move everything from staging to to-dir." (interactive) (pcase-let* ((name (completing-read "Copy attached docs to: " - my-org-attach-copy-attached-targets + my-copy-file-targets nil t)) - (`(,to ,staging) (alist-get name my-org-attach-copy-attached-targets + (`(,to ,staging) (alist-get name my-copy-file-targets nil nil #'equal))) - (let ((basedir (org-attach-dir)) - (failed nil)) - (dolist (attached (org-attach-file-list basedir)) - (when (string-match my-org-attach-copy-attached-doc-re attached) - (message "Copying %s to %s (%s)..." attached name to) - (condition-case nil - (copy-file (file-name-concat basedir attached) - (file-name-concat - to - (replace-regexp-in-string ":" "_" attached)) - t) - (error - (message "Hardlinking %s to %s staging area (%s)" - attached name staging) - (setq failed t) - (add-name-to-file - (file-name-concat basedir attached) - (file-name-concat - staging - (replace-regexp-in-string ":" "_" attached)) - t))) - (message "Done!"))) - (unless failed - (dolist (staged - (directory-files staging nil - my-org-attach-copy-attached-doc-re)) - (message "Moving staged %s to %s (%s)..." staged name to) - (copy-file (file-name-concat staging staged) - (file-name-concat - to - (replace-regexp-in-string ":" "_" staged)) - t) - (delete-file (file-name-concat staging staged)) - (message "Done!")))))) + (my-copy-files-with-staging + (directory-files-recursively (org-attach-dir) + my-org-attach-copy-attached-doc-re) + to + staging))) (defun my-org-attach-all-url-plaintext (arg) (interactive "P") @@ -1088,6 +1062,11 @@ On success, also move everything from staging to to-dir." (org-protocol-grok (list :url (plist-get eww-data :url)))) +(defun my-org-protocol-browse-url (data) + (when-let ((url (plist-get data :url))) + (browse-url url)) + nil) + ;; org capture rss (defun my-org-rss-xml-create-audio-node (url) (interactive (list (read-string "Feed URL: " @@ -1365,7 +1344,7 @@ With a prefix arg, yank and exit immediately." (org-edit-src-exit)))) ;; used to add an :after advice to `org-edit-special'. -(defun my-org-edit-special-after () +(defun my-org-edit-special-after (&rest _) ;; some modes (e.g. diff mode) are read-only by default, which ;; does not make sense when the intention is to edit (read-only-mode 0)) diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el index 396d919..a81d36d 100644 --- a/emacs/.emacs.d/lisp/my/my-prog.el +++ b/emacs/.emacs.d/lisp/my/my-prog.el @@ -419,7 +419,7 @@ overlay arrow in source buffer." ;; (gdb-input (concat "complete " context command) ;; (lambda () (setq gud-gdb-fetch-lines-in-progress nil))) ;; (while gud-gdb-fetch-lines-in-progress -;; (accept-process-output (get-buffer-process gud-comint-buffer) 1))) +;; (accept-process-output (get-buffer-process gud-comint-buffer) .1))) ;; (gud-gdb-completions-1 gud-gdb-fetched-lines))) ;;; which-func diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el index bc200c2..3ecd0a9 100644 --- a/emacs/.emacs.d/lisp/my/my-utils.el +++ b/emacs/.emacs.d/lisp/my/my-utils.el @@ -321,7 +321,7 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" (defvar my-extension-types '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus" - "wav" "wma" "spc")) + "wav" "wma" "spc" "mp4")) (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv")))) ;;; files @@ -332,6 +332,75 @@ Example: (format-time-string ... (my-time-from-epoch 1698582504))" (make-symbolic-link newname file ok-if-already-exists) newname) +(defvar my-copy-file-targets nil + "Alist of targets to copy attached to, in the form of (name dest staging)") + +(defun my-copy-buffer-file-with-staging () + (interactive) + (unless (buffer-file-name) (error "buffer-file-name is nil")) + (pcase-let* ((name + (completing-read (format "Copy %s to: " (buffer-file-name)) + my-copy-file-targets + nil t)) + (`(,dest ,staging) (alist-get name my-copy-file-targets + nil nil #'equal))) + (my-copy-file-with-staging + (buffer-file-name) dest staging))) + +(defun my-flush-staging-files (staging dest) + "Flush files from STAGING to DEST." + (dolist (staged (directory-files staging)) + (unless (file-directory-p (file-name-concat staging staged)) + (message "Moving staged %s to %s..." staged dest) + (copy-file (file-name-concat staging staged) + (file-name-concat dest staged) + t) + (delete-file (file-name-concat staging staged))))) + +(defun my-flush-staging-files-x () + (interactive) + (pcase-let* ((name + (completing-read (format "Copy %s to: " (buffer-file-name)) + my-copy-file-targets + nil t)) + (`(,dest ,staging) (alist-get name my-copy-file-targets + nil nil #'equal))) + (my-flush-staging-files staging dest))) + +(defun my-copy-file-with-staging (src dest staging) + "Copy a file SRC to DEST with fallback to hardlinking to STAGING." + (my-copy-files-with-staging (list src) dest staging)) + +(defun my-copy-files-with-staging (src dest staging) + "Copy a list of file SRC to DEST with staging. + +DEST and STAGING should be directories. +On failure, hard link to STAGING. +On success, also move everything from STAGING to DEST." + (cl-assert (listp src)) + (let (failed) + (dolist (file src) + (cond + ((not failed) + (message "Copying %s to %s..." file dest) + (condition-case err + (copy-file + file (file-name-concat dest (file-name-nondirectory file)) t) + (error + (message "Encountered error while copying: %s" + (error-message-string err)) + (message "Hardlinking instead %s to staging area %s" src staging) + (setq failed t) + (add-name-to-file + file (file-name-concat staging (file-name-nondirectory file)) t)))) + (t + (message "Hardlinking %s staging area %s" src staging) + (add-name-to-file + file (file-name-concat staging (file-name-nondirectory file)) t)))) + (unless failed + (my-flush-staging-files staging dest)) + (message "Done!"))) + (defun my-rewrite-url-advice (args) (let ((url (car args))) (setcar args (my-rewrite-url url))) diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el index 311bcf9..f2e48ba 100644 --- a/emacs/.emacs.d/lisp/my/my-web.el +++ b/emacs/.emacs.d/lisp/my/my-web.el @@ -86,19 +86,6 @@ (start-process (concat "mullvad-browser " url) nil "mullvad-browser" url)) -;; TODO: change to using hmm matching url with default app -;; override browse-url -(defun my-browse-url (url &optional arg) - (interactive "P") - (cond ((equal arg '(4)) - (funcall browse-url-secondary-browser-function url)) - ((equal arg '(16)) - (my-browse-url-tor-browser url)) - (t (luwak-open url)))) - -;; this fixes clicking url buttons like those in gnus messages -(defalias 'browse-url-button-open-url 'my-browse-url) - (defun my-browse-url-at-point (arg) (interactive "P") (my-browse-url (browse-url-url-at-point) arg)) @@ -148,5 +135,68 @@ (kill-new url) (message "Copied link: %s" url))) +;;; webgetter +(require 'my-net) +(defun my-open-spectator-au (url &optional no-overwrite) + (interactive "sspectator.com.au link: ") + (let ((url-request-extra-headers '(("X-Forwarded-For" . "66.249.66.1"))) + (url-user-agent "Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)")) + (let ((file-name + (if no-overwrite + (my-make-unique-file-name + (my-make-file-name-from-url url) + my-download-dir) + (expand-file-name + (my-make-file-name-from-url url) + my-download-dir)))) + (url-copy-file url file-name (not no-overwrite)) + (browse-url-firefox (format "file://%s" file-name))))) + +(defun my-mastodon-url-p (url) + "Guess if a url is a mastodon post. +e.g. https://hostux.social/@fsf/113709722998924141 +" + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj))) + (string-match-p "^/@[^/]+/[0-9]\\{18\\}$" path))) + +(defun my-hacker-news-url-p (url) + "Check if a url is a hacker news post. +e.g. https://news.ycombinator.com/item?id=42505454" + (let ((urlobj (url-generic-parse-url url))) + (and (equal "news.ycombinator.com" (url-host urlobj)) + (string-match-p "^/item\\?id=[0-9]+$" (url-filename urlobj))))) + +(defvar my-newscorp-au-amp-nk nil) +(defun my-open-newscorp-au (url) + (interactive "sNews Corp AU link: ") + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj))) + (setf (url-filename urlobj) + (format "%s?amp&nk=%s" path my-newscorp-au-amp-nk)) + (browse-url-firefox (url-recreate-url urlobj)))) + +(defun my-newscorp-au-url-p (url) + (string-match-p "^\\(www\\.\\)?\\(heraldsun\\|theaustralian\\)\\.com\\.au$" + (url-host (url-generic-parse-url url)))) + +(defun my-stack-overflow-url-p (url) + "Guess whether a url stack overflow question +e.g. +https://emacs.stackexchange.com/questions/40887/in-org-mode-how-do-i-link-to-internal-documentation" + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj))) + (string-match-p "^/questions/[0-9]+/.+$" path)) ) + +(advice-add 'server-visit-files :around #'my-ec-handle-http) +(defun my-ec-handle-http (orig-fun files client &rest args) + ;; (message "GOT %s" files) + (dolist (var files) + (let ((fname (expand-file-name (car var)))) + (when (string-match ".*/?\\(https?:\\)/+" fname) + (browse-url (replace-match "\\1//" nil nil fname)) + (setq files (delq var files))))) + (apply orig-fun files client args)) + (provide 'my-web) ;;; my-web.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el index 9118493..2811793 100644 --- a/emacs/.emacs.d/lisp/my/my-ytdl.el +++ b/emacs/.emacs.d/lisp/my/my-ytdl.el @@ -76,6 +76,33 @@ (if (eq type 'video) my-ytdl-video-args my-ytdl-audio-args) (split-string urls))))) +(defun my-ytdl-video-info (url) + "Given a video URL, return an alist of its properties." + (with-temp-buffer + (call-process my-ytdl-program nil t nil "--no-warnings" "-j" url) + (let ((start (point))) + (call-process-region + nil nil "jq" nil t nil + "pick(.webpage_url, .fulltitle, .channel_url, .channel, .channel_follower_count, .thumbnail, .duration_string, .view_count, .upload_date, .like_count, .is_live, .was_live, .categories, .tags, .chapters, .availability, .uploader, .description)") + (goto-char start) + (json-read))) + ) + +(defun my-ytdl-video-url-p (url) + (let ((urlobj (url-generic-parse-url url))) + (or (and (string-match-p "^\\(www\\.\\)?youtube.com" (url-host urlobj)) + (string-match-p "^/watch\\?v=.*" (url-filename urlobj))) + (equal "youtu.be" (url-host urlobj))))) + +(defun my-ytdl-video-infobox (url) + (interactive "sytdl video url: ") + (let* ((info (my-ytdl-video-info url)) + (specs (infobox-default-specs info))) + (infobox-render + (infobox-translate info specs) + `(my-ytdl-video-infobox ,url) + (called-interactively-p 'interactive)))) + ;;; fixme: autoload (defun my-ytdl-video (urls) "Download videos with ytdl." diff --git a/emacs/.emacs.d/lisp/my/reddio.el b/emacs/.emacs.d/lisp/my/reddio.el new file mode 100644 index 0000000..2198e43 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/reddio.el @@ -0,0 +1,53 @@ +;;; reddio.el -- reddit client through reddio -*- lexical-binding: t -*- + +;; Copyright (C) 2024 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: + +;; reddit client through reddio. + +;;; Code: + +(defvar reddio-buffer "*reddio*") + +(defun reddio-open-url (url) + (interactive "sReddit link: ") + (when (string-match "/\\(comments/[^/]+\\)/" url) + (with-current-buffer (get-buffer-create reddio-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (when (= 0 (call-process "reddio" nil reddio-buffer nil "print" + (match-string 1 url))) + (goto-char (point-min))) + (delete-trailing-whitespace)) + (text-mode) + (view-mode)) + (display-buffer reddio-buffer))) + +(defun reddio-reddit-url-p (url) + "e.g. +https://www.reddit.com/r/linux/comments/cs3os6/introducing_reddio_a_commandline_interface_for/" + (let ((urlobj (url-generic-parse-url url))) + (and (string-match-p "^.*\\<reddit.com$" (url-host urlobj)) + (string-match-p "^/r/[^/]+/comments/[^/]+/.+$" (url-filename urlobj))))) + +(provide 'reddio) +;;; reddio.el ends here diff --git a/emacs/.emacs.d/lisp/nov.el b/emacs/.emacs.d/lisp/nov.el -Subproject b3c7cc28e95fe25ce7b443e5f49e2e45360944a +Subproject c0d30da504fb0b68d8c28ff61a5e0095acda7f5 diff --git a/emacs/.emacs.d/lisp/wiki.el b/emacs/.emacs.d/lisp/wiki.el -Subproject e501c186bccd76a2373977b3df59300fe390bd6 +Subproject 3bb836e703480e23b3eee8fdb369dacb294dc46 |