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/infobox.el145
-rw-r--r--emacs/.emacs.d/lisp/my/my-buffer.el55
-rw-r--r--emacs/.emacs.d/lisp/my/my-emms.el50
-rw-r--r--emacs/.emacs.d/lisp/my/my-github.el50
-rw-r--r--emacs/.emacs.d/lisp/my/my-gitlab.el80
-rw-r--r--emacs/.emacs.d/lisp/my/my-ledger.el52
-rw-r--r--emacs/.emacs.d/lisp/my/my-mariadb.el43
-rw-r--r--emacs/.emacs.d/lisp/my/my-net.el10
-rw-r--r--emacs/.emacs.d/lisp/my/my-nov.el16
-rw-r--r--emacs/.emacs.d/lisp/my/my-org-jira.el10
-rw-r--r--emacs/.emacs.d/lisp/my/my-org-remark.el36
-rw-r--r--emacs/.emacs.d/lisp/my/my-org.el59
-rw-r--r--emacs/.emacs.d/lisp/my/my-package.el13
-rw-r--r--emacs/.emacs.d/lisp/my/my-prog.el52
-rw-r--r--emacs/.emacs.d/lisp/my/my-utils.el71
-rw-r--r--emacs/.emacs.d/lisp/my/my-web.el13
-rw-r--r--emacs/.emacs.d/lisp/my/my-ytdl.el27
17 files changed, 703 insertions, 79 deletions
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-mariadb.el b/emacs/.emacs.d/lisp/my/my-mariadb.el
index 6b0e06b..d790944 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.
@@ -270,5 +288,30 @@ switches to the buffer."
(file-name (format "/tmp/%s.wiki" term)))
(my-save-text-and-switch-to-buffer source file-name)))
+(defvar my-mtr-compilation-error-re
+ '(mtr "^mysqltest: At line \\([0-9]+\\)" nil 1))
+
+;; (defun my-mtr-find-test-file (test-name &optional dir)
+;; (unless dir (setq dir default-directory))
+;; ())
+
+(defun my-mtr-set-compile-command ()
+ (when (and buffer-file-name
+ (equal "test" (file-name-extension buffer-file-name)))
+ (when-let*
+ ((source-dir (expand-file-name (project-root (project-current))))
+ (build-dir (replace-regexp-in-string "/src/$" "/build/" source-dir))
+ (test-name
+ (progn
+ (when (string-match
+ "^.*/mysql-test/\\(.+?\\)/\\(t/\\)?\\([^/]+\\)\\.test$"
+ buffer-file-name)
+ (format "%s.%s"
+ (match-string 1 buffer-file-name)
+ (match-string 3 buffer-file-name))))))
+ (setq-local
+ compile-command
+ (format "%smysql-test/mtr %s" build-dir test-name)))))
+
(provide 'my-mariadb)
;;; my-mariadb.el ends here
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-package.el b/emacs/.emacs.d/lisp/my/my-package.el
index b591d0f..9eefa2e 100644
--- a/emacs/.emacs.d/lisp/my/my-package.el
+++ b/emacs/.emacs.d/lisp/my/my-package.el
@@ -216,6 +216,17 @@ same name, cancel that one first."
(cancel-timer ,var-name))
(setq ,var-name (run-with-timer ,secs ,repeat ,function))))
+(defmacro my-timer (var-name secs repeat function)
+ "Create a timer.
+
+The timer has name VAR-NAME. If there is an existing time with the
+same name, cancel that one first."
+
+ `(progn
+ (when (and (boundp ',var-name) (timerp ,var-name))
+ (cancel-timer ,var-name))
+ (setq ,var-name (run-with-timer ,secs ,repeat ,function))))
+
(defun my-describe-package-from-url (url)
(interactive "sUrl: ")
(when (string-match
@@ -263,7 +274,7 @@ same name, cancel that one first."
(add-hook hook function)))
(defvar my-common-packages
- '(package windmove consult icomplete
+ '(package windmove consult icomplete isearch
my-utils my-buffer my-editing my-complete)
"Common packages to include with any profile")
diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el
index 396d919..d93c745 100644
--- a/emacs/.emacs.d/lisp/my/my-prog.el
+++ b/emacs/.emacs.d/lisp/my/my-prog.el
@@ -365,8 +365,28 @@ left and the source buffer on the right.
(select-window (display-buffer (gdb-get-source-buffer))))
(defun my-gud-comint-set-prompt-regexp ()
- (setq comint-prompt-regexp "\\((rr)|(gdb)\\) "))
+ (setq comint-prompt-regexp "\\((rr)\\|(gdb)\\) *"))
+(defun my-gud-source-line ()
+ (with-current-buffer (gdb-get-source-buffer)
+ (buffer-substring (progn (beginning-of-line) (point))
+ (progn (end-of-line) (point)))))
+
+(defun my-gud-function-name ()
+ (with-current-buffer (gdb-get-source-buffer)
+ (which-function)))
+
+(defun my-gud-insert-source-line ()
+ (interactive)
+ (insert (my-gud-source-line)))
+
+(defun my-gud-insert-function-name ()
+ (interactive)
+ (insert (my-gud-function-name)))
+
+(defun my-gud-insert-source-line-and-function-name ()
+ (interactive)
+ (insert (format "%s IN %s" (my-gud-source-line) (my-gud-function-name))))
;;; used to override `gdb-frame-handler': do not re-display frame on
;;; completion.
@@ -419,7 +439,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
@@ -489,6 +509,34 @@ overlay arrow in source buffer."
(unless (derived-mode-p 'haskell-mode 'c-mode 'c++-mode)
(eglot-format-buffer))))
+;;; https://github.com/joaotavora/eglot/issues/88
+(defun my-eglot-ccls-inheritance-hierarchy (&optional derived)
+ "Show inheritance hierarchy for the thing at point.
+If DERIVED is non-nil (interactively, with prefix argument), show
+the children of class at point."
+ (interactive "P")
+ (if-let* ((res (jsonrpc-request
+ (eglot--current-server-or-lose)
+ :$ccls/inheritance
+ (append (eglot--TextDocumentPositionParams)
+ `(:derived ,(if derived t :json-false))
+ '(:levels 100) '(:hierarchy t))))
+ (tree (list (cons 0 res))))
+ (with-help-window "*ccls inheritance*"
+ (with-current-buffer standard-output
+ (while tree
+ (pcase-let ((`(,depth . ,node) (pop tree)))
+ (cl-destructuring-bind (&key uri range) (plist-get node :location)
+ (insert (make-string depth ?\ ) (plist-get node :name) "\n")
+ (make-text-button (+ (point-at-bol 0) depth) (point-at-eol 0)
+ 'action (lambda (_arg)
+ (interactive)
+ (find-file (eglot--uri-to-path uri))
+ (goto-char (car (eglot--range-region range)))))
+ (cl-loop for child across (plist-get node :children)
+ do (push (cons (1+ depth) child) tree)))))))
+ (eglot--error "Hierarchy unavailable")))
+
;;; lisp
(defun my-eval-defun-or-region (&optional arg)
"Call `eval-region' if region is active, otherwise call `eval-defun'"
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 f33f30c..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))
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."
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-14 17:19:38 +0000