diff options
78 files changed, 4564 insertions, 559 deletions
diff --git a/.gitmodules b/.gitmodules index 6917752..c762b4a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -6,7 +6,7 @@ url = https://g.ypei.me/dictionary-el.git [submodule ".emacs.d/lisp/nov.el"] path = emacs/.emacs.d/lisp/nov.el - url = https://depp.brause.cc/nov.el.git + url = https://g.ypei.me/nov.el.git [submodule ".emacs.d/lisp/esxml"] path = emacs/.emacs.d/lisp/esxml url = https://github.com/tali713/esxml @@ -118,3 +118,9 @@ [submodule "emacs/.emacs.d/lisp/bom.el"] path = emacs/.emacs.d/lisp/bom.el url = https://g.ypei.me/bom.el.git +[submodule "exitter"] + path = emacs/.emacs.d/lisp/exitter + url = https://g.ypei.me/exitter.git +[submodule "mastodon.el"] + path = emacs/.emacs.d/lisp/mastodon.el + url = https://codeberg.org/martianh/mastodon.el diff --git a/emacs/.emacs.d/init.el b/emacs/.emacs.d/init.el index 2d229b9..e066568 100644 --- a/emacs/.emacs.d/init.el +++ b/emacs/.emacs.d/init.el @@ -53,6 +53,7 @@ (require 'ycp-web) (require 'ycp-time) (require 'ycp-markup) +(require 'ycp-reading) (require 'ycp-pdf) (require 'ycp-project) (require 'ycp-org) diff --git a/emacs/.emacs.d/init/ycp-basic.el b/emacs/.emacs.d/init/ycp-basic.el index b03d0d4..cb097e7 100644 --- a/emacs/.emacs.d/init/ycp-basic.el +++ b/emacs/.emacs.d/init/ycp-basic.el @@ -27,6 +27,12 @@ ;;; Code: +;;; If started from systemd, emacs treats env variables inside env +;;; variables as literal. e.g. if we have +;;; Environment=PATH=$HOME/.local/bin:$HOME/bin +;;; emacs will set exec-path to be literally +;;; $HOME/.local/bin:$HOME/bin, without expanding $HOME. +(setq exec-path (seq-map 'substitute-in-file-name exec-path)) (my-configure (my-keybind global-map @@ -49,12 +55,15 @@ (setq attempt-stack-overflow-recovery nil) (setq confirm-kill-processes nil) (setq attempt-orderly-shutdown-on-fatal-signal nil) + ;; Use visible bell instead of beeping + (setq visible-bell t) ) (my-package my-utils (:delay 5) (my-setq-from-local my-audio-incoming-dir my-video-incoming-dir my-document-incoming-dir) + (my-setq-from-local my-copy-file-targets) (my-keybind global-map "C-c <f2>" #'my-rename-file-and-buffer "C-c <delete>" #'my-delete-file-and-kill-buffer diff --git a/emacs/.emacs.d/init/ycp-buffer.el b/emacs/.emacs.d/init/ycp-buffer.el index 7e1128a..944a45e 100644 --- a/emacs/.emacs.d/init/ycp-buffer.el +++ b/emacs/.emacs.d/init/ycp-buffer.el @@ -225,7 +225,7 @@ (my-package my-buffer (:delay 10) (my-keybind global-map - "<f1>" #'my-focus-write + "<f1>" #'my-toggle-focus-write "<insert>" #'my-cycle-windows "C-M-<mouse-4>" #'my-increase-default-face-height "C-M-<mouse-5>" #'my-decrease-default-face-height) diff --git a/emacs/.emacs.d/init/ycp-complete.el b/emacs/.emacs.d/init/ycp-complete.el index bd3b3ca..2f2117d 100644 --- a/emacs/.emacs.d/init/ycp-complete.el +++ b/emacs/.emacs.d/init/ycp-complete.el @@ -155,7 +155,11 @@ #'my-corfu-enable-always-in-minibuffer 1) ;;; corfu does not work well in gud as it "flushes" completion ;;; suggestions to the buffer - (setq corfu-exclude-modes '(gud-mode)) + ;;; https://github.com/minad/corfu/issues/157 + ;; Only company modes works with bbdb email completion in + ;; message-mode, so we remove corfu from message-mode to avoid + ;; overlapping multiple completion dropdowns + (setq global-corfu-modes '((not gud-mode) (not message-mode) t)) ) ;;; We still need company mode because corfu does not work well in @@ -163,7 +167,16 @@ (my-package company (:install t) (:delay 5) + ;; corfu does not complete email fields using bbdb (add-hook 'message-mode-hook #'company-mode) + ;; for some reason, having a t in the completion-at-point-functions + ;; causes company to hang in message-mode + (add-hook 'message-mode-hook + (lambda () + (setq-local completion-at-point-functions + (delq t + completion-at-point-functions)) + )) (setq company-idle-delay .1 company-minimum-prefix-length 3 company-selection-wrap-around t @@ -191,7 +204,14 @@ (message-mode ?' ?'))) (dolist (backend '(cape-elisp-symbol cape-keyword cape-file cape-history cape-dabbrev)) - (add-to-list 'completion-at-point-functions backend))) + (add-to-list 'completion-at-point-functions backend)) + ;; for some reason, cape-dabbrev causes message-mode to hang with + ;; company mode as well + ;; (add-hook 'message-mode-hook + ;; (lambda () + ;; (add-to-list 'completion-at-point-functions + ;; 'cape-dabbrev))) + ) (my-package imenu (:delay 5) @@ -271,6 +291,9 @@ (my-package consult-recoll (:delay 30) (:install t) + (add-to-list 'consult-recoll-open-fns + '("application/pdf" . my-consult-recoll-open-in-pdf-tools)) + (setq consult-recoll-inline-snippets t) ) (my-package hmm @@ -288,7 +311,14 @@ (:name qutebrowser :command my-browse-url-qutebrowser) (:name download-and-open :command my-fetch-url))) (setq hmm-external-handlers - '((:name mpv + '((:name feh + :external-command "feh %U" + :display-name "feh image viewer" + :description "Open url with feh" + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + :handling :url) + (:name mpv :external-command "mpv %U" :display-name "mpv player" :description "Play url with mpv" diff --git a/emacs/.emacs.d/init/ycp-editing.el b/emacs/.emacs.d/init/ycp-editing.el index 203b185..031ae31 100644 --- a/emacs/.emacs.d/init/ycp-editing.el +++ b/emacs/.emacs.d/init/ycp-editing.el @@ -30,6 +30,11 @@ ;; line wrap at window edge (setq-default truncate-lines nil) (setq kill-do-not-save-duplicates t) +(setq kill-transform-function + (lambda (s) (when (or + (derived-mode-p 'pdf-view-mode) + (string-match-p "[^ \t\n]" s)) + s))) (setq bidi-inhibit-bpa t) (setq save-interprogram-paste-before-kill t) (setq kill-ring-max 200) @@ -38,9 +43,10 @@ (setq window-divider-default-bottom-width 1) (setq line-number-display-limit-width 9999) (setq window-divider-default-places 'bottom-only) -;; don't interpret C-m as RET -(define-key input-decode-map [?\C-m] [C-m]) -(define-key input-decode-map [?\C-i] [C-i]) +;; If run in gui, don't interpret C-m as RET +(when (display-graphic-p) + (define-key input-decode-map [?\C-m] [C-m]) + (define-key input-decode-map [?\C-i] [C-i])) ;; fixme: the line below does not work ;; (define-key input-decode-map [?\C-M-m] [C-M-m]) (setq save-place-file (locate-user-emacs-file "saveplace")) @@ -93,6 +99,7 @@ "<C-M-backspace>" #'backward-kill-sexp "C-M-/" #'my-mark-backward-up-list "C-M-k" #'my-kill-sexp-or-comment + "C-x C-w" #'my-write-file ) (electric-pair-mode) (my-add-hooks #'my-non-special-modes-setup '(text-mode-hook prog-mode-hook)) @@ -107,7 +114,8 @@ (setq viper-mode nil) (my-package viper - (:delay 60)) + (:delay 60) + (setq viper-syntax-preference 'extended)) (define-key global-map [f2] 'revert-buffer) @@ -124,6 +132,16 @@ "M-g M-g" #'avy-goto-line) (setq avy-keys '(97 115 100 102 103 104 106 107 108))) +(my-package ispell + ;; Use aspell: + ;; https://battlepenguin.com/tech/aspell-and-hunspell-a-tale-of-two-spell-checkers/ + ;; also, ispell seems to have problem finding hunspell aff files + ;; using `ispell-find-hunspell-dictionaries', even though the files + ;; are available. + (setq ispell-program-name "aspell" + ispell-dictionary "en_GB") + ) + (my-package flyspell (my-keybind flyspell-mode-map "C-." nil diff --git a/emacs/.emacs.d/init/ycp-emms.el b/emacs/.emacs.d/init/ycp-emms.el index d83b53b..e49209f 100644 --- a/emacs/.emacs.d/init/ycp-emms.el +++ b/emacs/.emacs.d/init/ycp-emms.el @@ -34,18 +34,20 @@ (emms-all) (setq emms-playing-time-resume-from-last-played t) (add-to-list 'emms-info-functions 'emms-info-ytdl) + (add-to-list 'emms-info-functions 'my-emms-info-ffprobe) ;; emms-info-native is not very useful (delete 'emms-info-native emms-info-functions) (setq emms-source-file-default-directory (locate-user-emacs-file "emms")) (setq emms-source-playlist-default-format 'native) (setq emms-repeat-playlist t) (my-keybind emms-playlist-mode-map "C-x C-f" #'emms-play-playlist) - (setq emms-player-list '(emms-player-mpv)) + (setq emms-player-list '(emms-player-mpv emms-player-vlc)) (setq emms-player-vlc-parameters '("--intf=qt" "--extraintf=rc")) (setq emms-playlist-buffer-name "*EMMS Playlist*") (setq emms-source-file-directory-tree-function 'emms-source-file-directory-tree-find) (setq emms-info-ytdl-using-torsocks t) + (setq emms-info-auto-update nil) (add-hook 'emms-playlist-mode-hook #'hl-line-mode) (add-hook 'emms-metaplaylist-mode-hook #'hl-line-mode) ) @@ -81,8 +83,8 @@ "C-<return>" #'my-emms-playlist-mode-make-current "w" #'my-emms-playlist-kill-track-name-at-point "D" #'my-emms-playlist-delete-at-point - "R" #'my-emms-random-album - "N" #'my-emms-next-track-or-random-album + "R" #'my-emms-playlist-random-group + "N" #'my-emms-next-track-or-random-group ) (add-hook 'emms-player-started-hook 'my-emms-maybe-seek-to-last-played) (my-override emms-mode-line-enable) @@ -90,10 +92,19 @@ (my-override emms-mode-line-toggle) (add-hook 'emms-playlist-selection-changed-hook 'my-emms-output-current-track-to-i3bar-file) - (setq emms-player-next-function 'my-emms-next-track-or-random-album) + (add-hook 'emms-player-finished-hook 'my-emms-score-up-playing) + (add-hook 'emms-player-started-hook 'my-emms-score-up-chosen-bonus) + (add-hook 'emms-player-started-hook 'my-emms-playlist-maybe-mark-bounds) + (add-hook 'emms-player-started-hook 'my-emms-maybe-get-duration-for-current-track) + (setq emms-player-next-function 'my-emms-next-track-or-random-group) + (setq emms-players-preference-f 'my-emms-players-preference) (my-keybind dired-mode-map "e" #'my-dired-add-to-emms) (my-override emms-track-simple-description) (my-emms-add-all) + (my-timer emms-save-scores-timer nil 900 'emms-score-save-hash) + (my-override emms-mode-line-playlist-current) + (my-override emms-score-show-playing) + ;; (my-override emms-playing-time-mode-line) ) (provide 'ycp-emms) diff --git a/emacs/.emacs.d/init/ycp-gnus.el b/emacs/.emacs.d/init/ycp-gnus.el index 90a2c5a..9e89ee9 100644 --- a/emacs/.emacs.d/init/ycp-gnus.el +++ b/emacs/.emacs.d/init/ycp-gnus.el @@ -97,6 +97,15 @@ "C-c n u" #'gnus-group-get-new-news) (my-server-timer my-gnus-new-news-timer nil 300 'my-gnus-group-get-new-news-quietly) + ;; https://superuser.com/questions/519685/gnus-get-rid-of-mail-and-news-folders + ;; this also fixes issues with presumably nonexisting + ;; nndraft-directory causing + ;; (wrong-type-argument stringp nndraft-directory) + ;; which may require a restart of gnus to fix + (setq message-directory "~/.emacs.d/mail/") + (setq gnus-directory "~/.emacs.d/news/") + (setq nnfolder-directory "~/.emacs.d/mail/archive") + (setq nndraft-directory "~/.emacs.d/mail/drafts/") ) (my-configure @@ -142,7 +151,8 @@ "p" #'previous-line "m" #'my-gnus-group-compose "M-&" nil - "<RET>" #'my-gnus-topic-select-group) + "<RET>" #'my-gnus-topic-select-group + "q" #'bury-buffer) (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) ) @@ -173,8 +183,13 @@ ") (setq gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-date)) + (setq gnus-summary-next-group-on-exit nil) ) +(my-package gnus-art + (my-keybind gnus-article-mode-map + "w" #'my-copy-url-at-point)) + (my-package nnrss (:delay 60) (setq nnrss-use-local t)) @@ -207,6 +222,7 @@ (setq bbdb-dedicated-window t) (setq bbdb-message-all-addresses t) (setq bbdb-mua-pop-up-window-size .15) + (setq bbdb-mua-pop-up nil) (setq bbdb-new-mails-primary nil) (setq bbdb-ignore-redundant-mails t) (setq bbdb-mail-user-agent 'gnus-user-agent) diff --git a/emacs/.emacs.d/init/ycp-grep.el b/emacs/.emacs.d/init/ycp-grep.el index 85f15cd..f0ef8ce 100644 --- a/emacs/.emacs.d/init/ycp-grep.el +++ b/emacs/.emacs.d/init/ycp-grep.el @@ -107,6 +107,7 @@ ;;; org-recoll (my-package org-recoll (:delay 60) + (my-override org-recoll-format-results) (my-keybind org-recoll-mode-map "n" #'org-next-visible-heading "p" #'org-previous-visible-heading diff --git a/emacs/.emacs.d/init/ycp-help.el b/emacs/.emacs.d/init/ycp-help.el index 3503a6d..98fa58c 100644 --- a/emacs/.emacs.d/init/ycp-help.el +++ b/emacs/.emacs.d/init/ycp-help.el @@ -44,7 +44,8 @@ ) (my-package info - ;; TODO consider using `Info-additional-directory-list' instead + ;; Can't `Info-additional-directory-list' - won't be used in + ;; `info-display-manual' somehow (add-to-list 'Info-directory-list (locate-user-emacs-file "info"))) (my-keybind global-map @@ -81,7 +82,7 @@ (my-package my-help (:delay 10) (my-keybind global-map - "C-h M" #'my-woman-man + "C-h M" #'man "C-h i" #'my-info-display-manual "C-h ." #'my-describe-symbol-at-point "\C-h!" #'my-external-command-open-source) diff --git a/emacs/.emacs.d/init/ycp-markup.el b/emacs/.emacs.d/init/ycp-markup.el index e03fd86..c90dc6a 100644 --- a/emacs/.emacs.d/init/ycp-markup.el +++ b/emacs/.emacs.d/init/ycp-markup.el @@ -72,7 +72,11 @@ (my-keybind wiki-mode-map "C-'" #'my-wiki-grok-wikipedia) (my-setq-from-local wiki-sites) - (wiki-define-site-commands)) + (wiki-define-site-commands) + (add-to-list 'browse-url-handlers + `(wiki-engine-entry-url-p + . ,(lambda (url &rest _) (wiki-open-url url)))) + ) (my-package ledger-mode (:install t) @@ -83,17 +87,35 @@ (setq-local completion-cycle-threshold t) (setq-local ledger-complete-in-steps t) (setq-local company-mode nil))) - (setq ledger-binary-path "hledger")) + (setq ledger-binary-path "hledger") + (require 'my-ledger) + (my-keybind ledger-mode-map + "M-<down>" #'my-ledger-move-xact-down + "M-<up>" #'my-ledger-move-xact-up + "C-c C-c" #'compile) + (add-to-list 'compilation-error-regexp-alist 'ledger) + (add-to-list 'compilation-error-regexp-alist-alist my-ledger-compilation-error-re) + (add-hook 'ledger-mode-hook 'my-ledger-set-compile-command) + ) ;;; todo: open epub in emacs client with nov (my-package nov (:delay 15) (add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode)) - (setq nov-text-width fill-column) + ;; No fill, so it requires visual line mode to look nice + (setq nov-text-width t) + (add-hook 'nov-mode-hook 'visual-line-mode) (add-hook 'nov-mode-hook 'follow-mode) + (add-hook 'nov-mode-hook (lambda () + (setq line-spacing .1))) + (add-hook 'nov-post-html-render-hook 'my-nov-set-margins) (require 'my-nov) (my-override nov-render-title) (my-override nov-scroll-up) + (my-keybind nov-mode-map + "Q" #'my-nov-copy-buffer-file-with-staging + "i" #'imenu) + (add-to-list 'nov-shr-rendering-functions '(span . my-nov-render-span)) ) ;;; json-mode diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el index 2481cab..001dbe0 100644 --- a/emacs/.emacs.d/init/ycp-org.el +++ b/emacs/.emacs.d/init/ycp-org.el @@ -58,6 +58,8 @@ my-org-doc-dir) ;; disable auto-indent on RET (add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1))) + ;; tab-width 8 is needed for newer versions of org-mode, which I am + ;; not using due to performance issues (add-hook 'org-mode-hook (lambda () (setq-local tab-width 2))) ;; The world does not end by 2038 (hopefully) @@ -304,6 +306,7 @@ (setq org-clock-idle-time 15) (setq org-clock-mode-line-total 'auto) (setq org-clock-persist 'history) + (setq org-clock-continuously t) (org-clock-persistence-insinuate)) (my-package org-refile @@ -439,12 +442,16 @@ (add-to-list 'org-protocol-protocol-alist '("grok" :protocol "grok" - :function my-org-protocol-grok))) + :function my-org-protocol-grok)) + (add-to-list 'org-protocol-protocol-alist + '("browse-url" + :protocol "browse-url" + :function my-org-protocol-browse-url))) ;; org man links (my-package ol-man (:delay 30) - (setq org-man-command 'woman)) + (setq org-man-command 'man)) (my-package ol (:delay 10) @@ -496,17 +503,18 @@ (advice-add 'org-insert-structure-template :after 'my-org-edit-special) (advice-add 'org-edit-src-exit :before 'my-org-edit-src-before-exit) (advice-add 'org-edit-src-exit :after 'my-org-edit-src-after-exit) + (advice-add 'org-edit-special :after 'my-org-edit-special-after) (my-setq-from-local my-org-task-categories)) (my-package my-org (:delay 30) (require 'my-web) - (org-link-set-parameters "http" :follow (lambda (url arg) - (my-browse-url - (concat "http:" url) arg))) - (org-link-set-parameters "https" :follow (lambda (url arg) - (my-browse-url - (concat "https:" url) arg))) + (org-link-set-parameters "http" :follow + (lambda (url arg) + (browse-url (concat "http:" url) arg))) + (org-link-set-parameters "https" :follow + (lambda (url arg) + (browse-url (concat "http:" url) arg))) (require 'eww) (define-key eww-mode-map (kbd "C-'") 'my-eww-org-protocol-grok) ) @@ -515,5 +523,24 @@ (:delay 60) (require 'my-ox-jira)) +(my-package org-remark + (:install t) + (:delay 60) + (require 'my-org-remark) + (setq org-remark-notes-display-buffer-action + '(display-buffer-reuse-mode-window)) + (setq org-remark-notes-file-name + (locate-user-emacs-file "margin.org")) + (my-override org-remark-highlight-add-or-update-highlight-headline) + (require 'nov) + (my-keybind nov-mode-map + "M-n" #'org-remark-next + "M-p" #'org-remark-prev + "M" #'my-org-remark-open-or-create + "o" #'org-remark-view + "d" #'org-remark-delete) + (with-eval-after-load 'nov + (org-remark-nov-mode +1))) + (provide 'ycp-org) ;;; ycp-org.el ends here diff --git a/emacs/.emacs.d/init/ycp-pdf.el b/emacs/.emacs.d/init/ycp-pdf.el index 95b73bd..8e47f1c 100644 --- a/emacs/.emacs.d/init/ycp-pdf.el +++ b/emacs/.emacs.d/init/ycp-pdf.el @@ -55,7 +55,9 @@ "U" #'my-pdf-view-backward-node-lower-depth "." #'my-pdf-view-enlarge-a-bit "," #'my-pdf-view-shrink-a-bit + "Q" #'my-pdf-dptrp1-upload ) + (my-setq-from-local my-pdf-dptrp1-ip) ) (my-package pdf-misc diff --git a/emacs/.emacs.d/init/ycp-prog.el b/emacs/.emacs.d/init/ycp-prog.el index e2d7451..6584491 100644 --- a/emacs/.emacs.d/init/ycp-prog.el +++ b/emacs/.emacs.d/init/ycp-prog.el @@ -81,6 +81,7 @@ (setq gdb-many-windows t) (setq gdb-default-window-configuration-file (locate-user-emacs-file "gdb-window-conf")) + (setq gdb-debuginfod-enable-setting t) (require 'my-prog) (my-keybind global-map "C-c d q" 'my-gdb-quit @@ -105,9 +106,16 @@ "C-c C-n" 'comint-next-prompt "C-c C-u" 'gud-up "C-c C-d" 'gud-down - "C-c C-n" 'comint-next-prompt) + "C-c C-k" 'my-gud-insert-source-line + "C-c C-q" 'my-gud-insert-function-name + "C-," 'my-gud-insert-source-line-and-function-name + ) (add-hook 'gud-mode-hook 'my-gud-comint-set-prompt-regexp) (add-hook 'gud-mode-hook 'company-mode) + ;; Don't make this a general comint-mode hook, as it will overwrite + ;; bash history rather than append to it. + (add-hook 'gud-mode-hook 'my-comint-add-write-history-hook) + (my-override gdb-frame-handler) ) (my-package my-prog @@ -183,6 +191,8 @@ (:delay 5) (define-key c-mode-map (kbd "C-c C-c") 'compile) (define-key c++-mode-map (kbd "C-c C-c") 'project-compile) + (define-key c-mode-map (kbd "C-x C-e") 'my-gud-print-expr-region) + (define-key c++-mode-map (kbd "C-x C-e") 'my-gud-print-expr-region) (add-to-list 'auto-mode-alist '("\\.inl\\'" . c++-mode)) (setq c-default-style '((java-mode . "java") @@ -203,7 +213,7 @@ (add-hook 'c-mode-hook 'my-c-set-compile-command) (define-key c-mode-map (kbd "C-c s") 'my-c-switch-between-header-and-source) (define-key c++-mode-map (kbd "C-c s") - 'my-c-switch-between-header-and-source) + 'my-c-switch-between-header-and-source) (my-override bookmark-make-record) ) @@ -496,14 +506,16 @@ (setq comment-start "#")))) (add-to-list 'auto-mode-alist '("\\.cnf\\'" . conf-mode)) (require 'my-mariadb) + (add-hook 'sql-mode-hook 'my-mtr-set-compile-command) + (add-to-list 'compilation-error-regexp-alist 'mtr) + (add-to-list 'compilation-error-regexp-alist-alist + my-mtr-compilation-error-re) (define-key sql-mode-map (kbd "C-c C-c") 'my-sql-maybe-mtrr) (my-keybind global-map "C-c d m" 'my-gdb-maria "C-c d s" 'my-gdb-maria-spider ) (define-key gud-mode-map (kbd "C-c C-z") 'my-gdb-mysql-parse-frame) - (define-key gud-mode-map (kbd "C-c C-p") 'comint-previous-prompt) - (define-key gud-mode-map (kbd "C-c C-n") 'comint-next-prompt) (add-to-list 'grep-files-aliases '("mtr" . "*.inc *.test *.cnf *.result *.rdiff")) (add-to-list 'grep-files-aliases @@ -538,7 +550,8 @@ ;;; nxml (my-package nxml-mode (:delay 60) - (setq nxml-slash-auto-complete-flag t)) + (setq nxml-slash-auto-complete-flag t) + (add-to-list 'auto-mode-alist '("\\.opf\\'" . nxml-mode))) (my-package etags (:delay 60) diff --git a/emacs/.emacs.d/init/ycp-reading.el b/emacs/.emacs.d/init/ycp-reading.el new file mode 100644 index 0000000..5c0284e --- /dev/null +++ b/emacs/.emacs.d/init/ycp-reading.el @@ -0,0 +1,34 @@ +;;; ycp-reading.el -- Reading related customisation -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "29.4")) + +;; This file is part of dotted. + +;; dotted is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; dotted is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. + +;; You should have received a copy of the GNU Affero General Public +;; License along with dotted. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Reading related customisation. + +;;; Code: + +(my-package belf + (my-setq-from-local belf-dir belf-locate-dirs) + (add-hook 'find-file-hook 'belf-recent-add-current) + (blink-cursor-mode 0)) + +(provide 'ycp-reading) diff --git a/emacs/.emacs.d/init/ycp-theme.el b/emacs/.emacs.d/init/ycp-theme.el index ee76311..c6721ed 100644 --- a/emacs/.emacs.d/init/ycp-theme.el +++ b/emacs/.emacs.d/init/ycp-theme.el @@ -41,6 +41,7 @@ 'normal :weight 'normal :height 150 :width 'normal) (set-face-attribute 'fixed-pitch nil :family "Ubuntu Mono" :foundry "DAMA" :slant 'normal :weight 'normal :height 150 :width 'normal) +(set-face-attribute 'variable-pitch nil :family "Ubuntu" :foundry "DAMA") (provide 'ycp-theme) ;;; ycp-theme.el ends here diff --git a/emacs/.emacs.d/init/ycp-time.el b/emacs/.emacs.d/init/ycp-time.el index f98a9cd..f21061c 100644 --- a/emacs/.emacs.d/init/ycp-time.el +++ b/emacs/.emacs.d/init/ycp-time.el @@ -83,7 +83,7 @@ (holiday-fixed 1 26 "Australia Day (Vic holiday)") (holiday-float 3 1 2 "Labour Day (Vic holiday)") (holiday-fixed 4 25 "Anzac Day (Vic holiday)") - (holiday-float 6 1 2 "Monarch's Birthday (Vic oliday)") + (holiday-float 6 1 2 "Monarch's Birthday (Vic holiday)") (holiday-fixed 6 30 "End of financial year") (holiday-float 9 5 -1 "(Possibly) Friday before the AFL Grand Final (Vic holiday)") (holiday-float 10 5 1 "(Possibly) Friday before the AFL Grand Final (Vic holiday)") @@ -123,7 +123,7 @@ (setq appt-display-interval 5) ;; dbus notification of appt (require 'my-time) - (setq appt-disp-window-function #'my-app-display-window) + (setq appt-disp-window-function #'my-appt-display-window) ;; with org-agenda-to-appt (require 'org-clock) (require 'my-utils) diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el index d188afd..67c5e5a 100644 --- a/emacs/.emacs.d/init/ycp-web.el +++ b/emacs/.emacs.d/init/ycp-web.el @@ -34,6 +34,8 @@ (ignore-errors (cancel-timer url-cookie-timer)) (setq shr-cookie-policy nil) +(setq browse-url-handlers + '((stringp . browse-url-firefox))) (my-package luwak (:delay 10) @@ -184,7 +186,12 @@ (my-override hnreader--print-frontpage) (my-override hnreader--print-frontpage-item) (my-override hnreader--print-comments) - (my-override hnreader--get-title)) + (my-override hnreader--get-title) + (require 'my-web) + (add-to-list 'browse-url-handlers + `(my-hacker-news-url-p + . ,(lambda (url &rest _) (hnreader-comment url)))) + ) (add-to-list 'load-path (locate-user-emacs-file "lisp/lem.el/lisp")) (my-package lem-org @@ -203,6 +210,7 @@ org-jira-jira-status-to-org-keyword-alist org-jira-project-filename-alist org-jira-custom-jqls) + (org-link-set-parameters "jira" '((:follow . org-jira-open))) (require 'my-org-jira) (my-override org-jira--render-issue) (my-override org-jira-update-worklogs-from-org-clocks) @@ -212,7 +220,16 @@ (add-hook 'org-jira-mode-hook (lambda () (setq show-trailing-whitespace nil))) (add-hook 'org-jira-mode-hook - 'turn-off-auto-fill) ) + 'turn-off-auto-fill) + (add-hook 'org-jira-mode-hook + 'turn-off-flyspell) + (add-to-list 'browse-url-handlers + `(my-org-jira-url-p + . ,(lambda (url &rest _) (my-org-jira-open-url url)))) + ) + +(my-package dnd + (setq dnd-open-remote-file-function 'browse-url)) (my-package eww (:delay 60) @@ -235,6 +252,7 @@ (my-package my-web (:delay 60) + (my-setq-from-local my-webpage-download-dir) (my-keybind eww-mode-map "N" #'my-eww-next-path "P" #'my-eww-prev-path @@ -242,9 +260,36 @@ "T" #'my-eww-top-path "b" #'my-eww-switch-by-title) (my-keybind global-map "\C-c\C-o" #'my-browse-url-at-point) - (my-override browse-url) + (my-setq-from-local my-newscorp-au-amp-nk) + (add-to-list 'browse-url-handlers + `(my-newscorp-au-url-p + . ,(lambda (url &rest _) (my-open-newscorp-au url)))) + (add-to-list 'browse-url-handlers + `("^https?://www.spectator.com.au\\>" . + ,(lambda (url &rest _) (my-fetch-browse-as-googlebot url)))) + (my-setq-from-local my-firefox-profile-dir)) + +(my-package my-gitlab + (:delay 60) + (add-to-list 'browse-url-handlers + `(my-gitlab-project-url-p + . ,(lambda (url &rest _) (my-gitlab-project-infobox url)))) + ) + +(my-package my-github + (:delay 60) + (add-to-list 'browse-url-handlers + `(my-github-project-url-p + . ,(lambda (url &rest _) (my-github-project-infobox url)))) ) +(my-package my-ytdl + (:delay 60) + (add-to-list 'browse-url-handlers + `(my-ytdl-video-url-p + . ,(lambda (url &rest _) (my-ytdl-video-infobox url))))) + + (my-package my-semantic-scholar (:delay 60)) @@ -277,18 +322,28 @@ ;; sx: a stack exchange client (my-package sx (:delay 60) - (require 'sx-load)) + (require 'sx-load) + (require 'my-web) + (add-to-list 'browse-url-handlers + `(my-stack-overflow-url-p + . ,(lambda (url &rest _) (sx-open-link url)))) + ) -;; mastodon +;; mastodon.el +(add-to-list 'load-path (locate-user-emacs-file "lisp/mastodon.el/lisp")) (my-package mastodon - (:install t) (my-setq-from-local mastodon-active-user mastodon-instance-url) ;; auto fill is a bit glitchy when composing a toot (add-hook 'mastodon-toot-mode-hook (lambda () (turn-off-auto-fill))) (mastodon)) -(my-package mastorg - (:delay 60)) +(my-package fediorg + (:delay 60) + (require 'my-web) + (add-to-list 'browse-url-handlers + `(fediorg-post-url-p + . ,(lambda (url &rest _) (fediorg-open url)))) + ) (add-to-list 'load-path (locate-user-emacs-file "lisp/servall/lisp")) (my-package servall-wikipedia @@ -303,9 +358,11 @@ (:delay 60) (require 'my-utils) (my-setq-from-local my-libgen-hosts my-libgen-alt-hosts - my-libgen-library-hosts + my-libgen-library-hosts my-libgen-onion-host + my-libgen-plus-host ) - (setq my-libgen-download-dir my-document-incoming-dir) + (setq my-libgen-download-dir my-document-incoming-dir + my-libfic-download-dir my-document-incoming-dir) (my-libgen-set-random-hosts)) (my-package my-scihub @@ -325,4 +382,24 @@ ) (require 'w3m-load)) +(my-package exitter + (:delay 60) + (my-setq-from-local + exitter-oauth-consumer-key exitter-oauth-consumer-secret + exitter-access-token exitter-username exitter-password exitter-email + exitter-oauth-token exitter-oauth-token-secret exitter-oauth-token-ctime) + (setq exitter-debug nil) + (add-to-list 'browse-url-handlers + `(exitter-post-url-p + . ,(lambda (url &rest _) (exitter-open-post url)))) + + ) + +(my-package reddio + (:delay 60) + (add-to-list 'browse-url-handlers + `(reddio-reddit-url-p + . ,(lambda (url &rest _) (reddio-open-url url)))) + ) + (provide 'ycp-web) diff --git a/emacs/.emacs.d/lisp/exitter b/emacs/.emacs.d/lisp/exitter new file mode 160000 +Subproject 7ccd8ff06b50008ad0602c6652caebd4c4674a6 diff --git a/emacs/.emacs.d/lisp/hmm.el b/emacs/.emacs.d/lisp/hmm.el -Subproject 2157ead39273691013c38529b14953ea839c2a5 +Subproject 318723000cad21c0134eefd33e310b953ddbbe7 diff --git a/emacs/.emacs.d/lisp/magit-annex b/emacs/.emacs.d/lisp/magit-annex -Subproject 018e8eebd2b1e56e9e8c152c6fb249f4de52e2d +Subproject 9db0bc61461f222106c7ae3d8cd6d3de1f1b143 diff --git a/emacs/.emacs.d/lisp/mastodon.el b/emacs/.emacs.d/lisp/mastodon.el new file mode 160000 +Subproject dbb1e5ef4473c418b164b4c74c44cf8ac95e4eb diff --git a/emacs/.emacs.d/lisp/my/belf.el b/emacs/.emacs.d/lisp/my/belf.el new file mode 100644 index 0000000..0db79f6 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/belf.el @@ -0,0 +1,536 @@ +;;; belf.el -- Bookshelf, ebook library management -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "29.4")) + +;; This file is part of dotted. + +;; dotted is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; dotted is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. + +;; You should have received a copy of the GNU Affero General Public +;; License along with dotted. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Bookshelf, ebook library management. + +;;; Code: + +(require 'tabulated-list) +(require 'infobox) +(require 'my-epub) + +(defvar-keymap belf-mode-map + :parent tabulated-list-mode-map + "F" #'belf-toggle-follow-mode + "RET" #'belf-open-book + "b" #'tabulated-list-previous-column + "d" #'belf-show-in-dired + "f" #'tabulated-list-next-column + "i" #'belf-book-infobox-at-point + "n" #'belf-next-line + "o" #'belf-open-book-other-window + "p" #'belf-previous-line + "e" #'belf-set-field + "," #'belf-rename-desort-at-point + "E" #'belf-epub-rename-at-point + ;; "s" #'tabulated-list-col-sort + ) + +(define-derived-mode belf-mode tabulated-list-mode "Bookshelf" + "Major mode for browsing a list of books." + (setq tabulated-list-format + [("Authors" 25 belf-compare-authors) + ("Title" 48 belf-compare-title) + ("Year" 4 t)]) + (setq tabulated-list-padding 2) + (tabulated-list-init-header) + (setq revert-buffer-function #'belf-list-refresh-contents) + (hl-line-mode)) + +(defun belf () + (interactive) + (let ((buf (get-buffer-create "*Bookshelf*"))) + (with-current-buffer buf + (belf-mode) + (belf-list-refresh-contents)) + (pop-to-buffer-same-window buf))) + +(defun belf-library (dir) + (interactive (list (read-directory-name "Book directory: " belf-dir nil t))) + (setq belf-dir dir) + (belf)) + +(defun belf-list-refresh-contents (&rest _) + (setq-local tabulated-list-entries (belf-parse-all-file-names)) + (tabulated-list-print)) + +(defvar belf-dir "~/Documents" "Directory of books.") + +(defun belf-parse-file-names (file-names) + (seq-filter + #'identity + (seq-map + (lambda (f) + (when-let ((parsed (belf-parse-file-name f))) + (let-alist parsed + (list f (vector .authors .title .year))))) + file-names))) + +(defun belf-parse-all-file-names () + (belf-parse-file-names (directory-files belf-dir t "\\.\\(epub\\|pdf\\|cbr\\|djvu\\|mobi\\|azw3\\)$"))) + +(defun belf-file-name-desort (file-name new-dir) + "Rename a file. + +Change authors-sort to authors. Change title-sort to title. + +Test: +foo bar +foo, bar +foo bar, quux baf +foo, bar & quux, baf +foo bar & quux, baf" + (when-let ((parsed (belf-parse-file-name file-name))) + (let* ((authors (string-split (alist-get 'authors parsed) " & " t " +")) + (title (alist-get 'title parsed))) + (setf + (alist-get 'authors parsed) + (mapconcat + (lambda (author) + (let ((comma-split (string-split author ", "))) + (if (or ;; no comma or more than one comma + (/= (length comma-split) 2) + ;; at least one space before the comma + (string-match-p " " (car comma-split))) + author + ;; from author-sort to author + (format "%s %s" (cadr comma-split) (car comma-split)) + ))) + authors + ", ") + (alist-get 'title parsed) + (cond ((string-suffix-p ", The" title) + (concat "The " (string-remove-suffix ", The" title))) + ((string-suffix-p ", A" title) + (concat "A " (string-remove-suffix ", A" title))) + (t title)))) + (format "%s.%s" + (belf-format-base-name parsed new-dir) + (alist-get 'ext parsed)))) + +(defun belf-rename-desort (file-name new-dir) + (when-let ((new-name (belf-file-name-desort file-name new-dir))) + (unless (equal new-name file-name) + (rename-file file-name new-name)))) + +(defun belf-rename-desort-at-point () + (interactive) + (let ((file-name (tabulated-list-get-id))) + (belf-rename-desort file-name (file-name-directory file-name)) + (revert-buffer))) + +(defun belf-rename-desort-files (dir new-dir) + (interactive) + (dolist (file-name + (directory-files dir t directory-files-no-dot-files-regexp)) + (belf-rename-desort file-name new-dir))) + +(defun belf-epub-rename-files (dir new-dir) + (dolist (epub (directory-files dir t "\\.epub$")) + (belf-epub-rename epub new-dir))) + +(defun belf-epub-rename (file-name new-dir) + (when-let ((meta (my-epub-metadata file-name))) + (let* ((dir (file-name-directory file-name)) + (new-base-name (belf-format-base-name meta new-dir)) + new-name) + (dolist (file (directory-files dir t + (format "^%s\\.[a-zA-Z0-9]+$" + (regexp-quote + (file-name-base file-name))))) + (setq new-name (format "%s.%s" new-base-name (file-name-extension file))) + (unless (equal file-name new-name) + (message "%s -> %s" file new-name) + (ignore-error 'file-already-exists (rename-file file new-name)) + ) + ) + ) + )) + +(defun belf-move-invalid-file-names (dir new-dir) + "Move files in DIR whose file names do not validate to NEW-DIR." + (let (new-name) + (dolist (file-name (directory-files dir t directory-files-no-dot-files-regexp)) + (unless (string-match-p "^.*? +- +.* +([0-9]*) +\\[.*\\]\\.[a-zA-Z0-9]+$" file-name) + (message "%s -> %s" file-name + (setq new-name (file-name-concat + new-dir (file-name-nondirectory file-name)))) + (rename-file file-name new-name) + )))) + +(defun belf-dired-do-epub-rename () + (interactive) + (seq-do + (lambda (file) + (when (equal (upcase (file-name-extension file)) "EPUB") + (belf-epub-rename file (file-name-directory file)))) + (dired-get-marked-files))) + +(defun belf-epub-rename-at-point () + (interactive) + (let ((file-name (tabulated-list-get-id))) + (belf-epub-rename file-name (file-name-directory file-name)) + (revert-buffer))) + +(defun belf-parse-file-name (file-name) + (let ((fn (file-name-nondirectory file-name))) + (when (string-match "^\\(.*?\\) +- +\\(.*\\) +(\\([0-9]*\\)) +\\[\\(.*\\)\\]\\.\\([a-zA-Z0-9]+\\)$" fn) + `((authors . ,(match-string 1 fn)) + (title . ,(match-string 2 fn)) + (year . ,(match-string 3 fn)) + (identifier . ,(match-string 4 fn)) + (ext . ,(match-string 5 fn)))))) + +(defun belf-format-base-name (info &optional dir) + (let-alist info + (file-name-concat + (expand-file-name (or dir belf-dir)) + (replace-regexp-in-string + "[/:?*\"]" "_" + (format "%s - %s (%s) [%s]" .authors .title .year .identifier))))) + +(defun belf-book-infobox (file-name) + (interactive) + (belf-book-render-info (belf-exiftool-info file-name) file-name)) + +(defvar belf-exiftool-program "exiftool" "The exiftool program.") + +(defun belf-exiftool-info (file-name) + "Given a video URL, return an alist of its properties." + (with-temp-buffer + (call-process belf-exiftool-program nil t nil "-j" file-name) + (let ((start (point))) + (call-process-region + nil nil "jq" nil t nil + ".[0]|pick(.Title, .Author, .Creator, .Keywords, .Subject, .Publisher, .Identifier, .Series, .Title_sort, .Author_sort, .PageCount, .FileSize, .ISBN, .Language, .FileType, .Description)") + (goto-char start) + (json-read))) + ) + +(defun belf-epub-cover-file-name (file-name content-file-name) + (with-temp-buffer + (call-process "unzip" nil t nil "-p" file-name content-file-name) + (let* ((dom (libxml-parse-xml-region (point-min) (point-max))) + (metas + (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'metadata) 'meta)) + (items + (dom-by-tag (dom-by-tag (dom-by-tag dom 'package) 'manifest) 'item)) + cover-name + cover-file + cover-file-from-prop) + (while (and metas (not cover-name)) + (let-alist (cadr (car metas)) + (when (equal .name "cover") + (setq cover-name .content))) + (setq metas (cdr metas))) + (while (and items (not cover-file)) + (let-alist (cadr (car items)) + (when (equal .id cover-name) + (setq cover-file .href)) + (when (equal .properties "cover-image") + (setq cover-file-from-prop .href))) + (setq items (cdr items))) + (cond (cover-file + (file-name-concat (file-name-directory content-file-name) + cover-file)) + (cover-file-from-prop + (file-name-concat (file-name-directory content-file-name) + cover-file-from-prop)) + ((not cover-name) + (message "Could not find cover in epub metadata.") + nil) + ;; If no cover-file, then try cover-name if it looks like + ;; an image file path + ((string-match-p belf-book-cover-re cover-name) + (file-name-concat (file-name-directory content-file-name) + cover-name))) + ))) + +(defvar belf-book-cover-exts '("jpg" "png" "jpeg")) +(defvar belf-book-cover-re + (concat "^.*\\." (regexp-opt belf-book-cover-exts) "$")) + +(defun belf-locate-book-cover (file-name) + (let ((exts belf-book-cover-exts) + cover-file-name + found) + (while (and exts (not found)) + (setq cover-file-name (file-name-with-extension file-name (car exts)) + exts (cdr exts) + found (file-exists-p cover-file-name))) + (when found cover-file-name))) + +(defun belf-pdf-page-one-cover (file-name) + "Extract the first page of a pdf file as cover." + (let ((cover-file (file-name-with-extension file-name "jpg"))) + (with-temp-buffer + (if (eq 0 + (call-process "gs" nil t t + "-dNOPAUSE" "-dBATCH" "-sDEVICE=jpeg" "-r300" + (format "-sOutputFile=%s" cover-file) + "-dFirstPage=1" "-dLastPage=1" file-name)) + cover-file + (message "Failed to extract cover from PDF: %s" (buffer-string)) + nil)))) + +(defun belf-book-cover (file-name) + "Get book cover. + +First look for an image file with the same file name. +Then for PDF, extract the first page. +For EPUB, looks for a cover image in the file." + (if-let ((cover-file-name (belf-locate-book-cover file-name))) + (concat "file://" cover-file-name) + (cond ((equal "epub" (file-name-extension file-name)) + (when-let* ((content-file-name (belf-epub-content-file-name file-name)) + (cover-file + (belf-epub-cover-file-name file-name content-file-name)) + (cover-file-name (file-name-with-extension + file-name + (file-name-extension cover-file)))) + (call-process "unzip" nil `(:file ,cover-file-name) nil + "-p" file-name cover-file) + (format "file://%s" cover-file-name))) + ((equal "pdf" (file-name-extension file-name)) + (when (setq cover-file-name (belf-pdf-page-one-cover file-name)) + (format "file://%s" cover-file-name)))))) + +(defun belf-set-field () + (interactive) + (cond ((equal "Authors" + (get-text-property (point) 'tabulated-list-column-name)) + (call-interactively 'belf-set-authors)))) + +(defun belf-set-authors (new-authors) + (interactive + (list + (read-string "Set authors to: " + (alist-get 'authors (belf-parse-file-name + (tabulated-list-get-id)))))) + (let* ((file-name (tabulated-list-get-id)) + (dir (file-name-directory file-name)) + (parsed (belf-parse-file-name file-name)) + new-base-name + new-file) + (setf (alist-get 'authors parsed) new-authors) + (setq new-base-name (belf-format-base-name parsed dir)) + (dolist (file (directory-files dir t + (format "^%s\\.[a-zA-Z0-9]+$" + (regexp-quote + (file-name-base file-name))))) + (setq new-file (format "%s.%s" new-base-name (file-name-extension file))) + (message "%s -> %s" file new-file) + (rename-file file new-file)) + (revert-buffer))) + +(defun belf-parse-first-author-name (authors) + "Returns (last-name . first-name) of the first author of AUTHORS." + (when (string-match-p))) + +(defun belf-compare-authors (x y) + "Authors comparator. + +Authors are in the format of +fname1 lname1, fname2 lname2, ..." + (string< + (car (last (string-split (car (string-split (elt (cadr x) 0) ", ")) " "))) + (car (last (string-split (car (string-split (elt (cadr y) 0) ", ")) " "))))) + +(defun belf-compare-title (x y) + "Title comparator. + +Compare without leading \"The \"." + (string< + (string-remove-prefix "The " (elt (cadr x) 1)) + (string-remove-prefix "The " (elt (cadr y) 1)))) + +(defun belf-book-infobox-at-point () + (interactive) + (let ((help-window-select (not belf-follow-mode))) + (belf-book-infobox (tabulated-list-get-id))) + ) + +(defun belf-book-render-info (info file-name) + (setf (alist-get 'Title info) + (concat (alist-get 'Title info) + " -- " + (buttonize "context" + (lambda (_) + (funcall my-file-context-function file-name))) + " " (buttonize "find-file" (lambda (_) (find-file file-name)))) + (alist-get 'Thumbnail info) + (belf-book-cover file-name) + (alist-get 'Description info) + (when-let ((text (alist-get 'Description info))) + (with-temp-buffer + (insert + (if (stringp text) text (prin1-to-string text))) + (shr-render-region (point-min) (point-max)) + (goto-char (point-min)) + (insert "\n") + (buffer-string)))) + (infobox-render + (infobox-translate info (infobox-default-specs info)) + `(belf-book-infobox ,file-name) + (called-interactively-p 'interactive))) + +(defvar belf-follow-mode nil "Whether follow mode is on.") + +(defun belf-toggle-follow-mode () + (interactive) + (setq belf-follow-mode (not belf-follow-mode))) + + +(defun belf-previous-line () + (interactive) + (previous-line) + (when belf-follow-mode + (belf-book-infobox-at-point))) + +(defun belf-next-line () + (interactive) + (next-line) + (when belf-follow-mode + (belf-book-infobox-at-point))) + +(defun belf-show-in-dired () + (interactive) + (dired-jump-other-window (tabulated-list-get-id))) + +(defun belf-open-book () + (interactive) + (find-file (tabulated-list-get-id))) + +(defun belf-open-book-other-window () + (interactive) + (find-file-other-window (tabulated-list-get-id))) + +;;; belf-recent + +(defvar belf-recent-file (locate-user-emacs-file "belf-list")) + +(defun belf-recent-add (file) + "Add FILE to `belf-recent-file'. + +Can be used as a `find-file-hook'." + (when (string-match-p "\\.\\(epub\\|pdf\\|cbr\\|djvu\\|mobi\\|azw3\\)$" + file) + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (flush-lines (rx-to-string `(and bol "[" (= 23 anychar) "] " ,file eol))) + (insert + (format-time-string "[%Y-%m-%d %a %H:%M:%S]" (current-time)) + " " + file + "\n") + (write-file belf-recent-file) + ))) + +(defun belf-recent-add-current () + (when buffer-file-name + (belf-recent-add buffer-file-name))) + +(define-derived-mode belf-recent-mode belf-mode "Bookshelf Recent" + "Major mode for browsing a list of books." + (setq revert-buffer-function #'belf-recent-list-refresh-contents)) + +(defun belf-recent () + (interactive) + (let ((buf (get-buffer-create "*Bookshelf Recent*"))) + (with-current-buffer buf + (belf-recent-mode) + (belf-recent-list-refresh-contents)) + (pop-to-buffer-same-window buf))) + +;; (defvar belf-find-dir nil +;; "Directory to run find command for relocated files.") + +(defvar belf-locate-dirs nil + "Directories to look for relocated files.") + +(defun belf-recent-bookkeeping () + "Check `belf-recent-file' for (re)moved files and update accordingly." + (interactive) + (copy-file belf-recent-file (concat belf-recent-file ".bak") t) + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 26) + (let* ((beg (point)) + (end (progn (end-of-line) (point))) + (file-name (buffer-substring-no-properties beg end))) + (unless (file-exists-p file-name) + (let ((dirs belf-locate-dirs) + (file-name-nodir (file-name-nondirectory file-name)) + dir new-name found) + (delete-region beg end) + (while (and (not found) dirs) + (setq dir (expand-file-name (car dirs)) + new-name (file-name-concat dir file-name-nodir) + found (file-exists-p new-name) + dirs (cdr dirs))) + (when found (insert new-name))) + ;; Running find on a big dir is too slow even when there are + ;; only a few thousands subdirs + ;; (call-process "find" nil (current-buffer) nil + ;; (expand-file-name belf-find-dir) + ;; "-name" (file-name-nondirectory file-name)) + ) + (beginning-of-line 2))) + + ;; Remove empty records that could not be found + (goto-char (point-min)) + (flush-lines (rx bol (= 26 anychar) eol)) + + ;; Deduplicate + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 26) + (let* ((beg (point)) + (end (progn (end-of-line) (point))) + (file-name (buffer-substring-no-properties beg end))) + (flush-lines + (rx-to-string `(and bol "[" (= 23 anychar) "] " ,file-name eol)))) + (beginning-of-line 2)) + (write-file belf-recent-file))) + +(defun belf-recent-list-refresh-contents (&rest _) + (belf-recent-bookkeeping) + (setq-local tabulated-list-entries (belf-recent-parse-file-names)) + (tabulated-list-print)) + +(defun belf-recent-parse-file-names () + (with-temp-buffer + (when (file-exists-p belf-recent-file) + (insert-file-contents belf-recent-file)) + (goto-char (point-min)) + (replace-regexp (rx bol (= 26 anychar)) "") + (belf-parse-file-names (string-lines (buffer-string)))) + ) + +(provide 'belf) diff --git a/emacs/.emacs.d/lisp/my/fediorg.el b/emacs/.emacs.d/lisp/my/fediorg.el new file mode 100644 index 0000000..e2f21b8 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/fediorg.el @@ -0,0 +1,368 @@ +;;; fediorg.el -- Read and archive fedi post context in org mode -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; 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: + +;; Read or archive a fedi thread context in org mode. This is a +;; standalone library, and can be used without any other files in this +;; project. + +;; Usage: +;; M-x fediorg-open <RET> https://pleroma.instance/notice/... <RET> +;; M-x fediorg-open <RET> https://mastodon.instance/@user/... <RET> +;; +;; The post, together with its ancestors and descendants, subject to +;; the API depth limit, are displayed in an org buffer. + +;; TODO: +;; +;; To be able to refresh the org buffer at an org entry, which would +;; re-fetch the context of the corresponding post and upsert them in +;; the buffer. +;;; Code: + + +(require 'hierarchy) +(require 'json) +(require 'url-parse) + +(defvar fediorg-buffer "*fediorg*" "Buffer name for fediorg buffers.") + +;;; Fetching utilities +(defvar fediorg-client-buffer-name "*fediorg-api*" + "Buffer name for logging API requests.") + +(defun fediorg-url-fetch-json (url &optional decompression with-header) + "Fetch and parse json from URL. + +With nonnil DECOMPRESSION, gunzip the response first. +With nonnil WITH-HEADER, include the response headers in the return value." + (fediorg-url-fetch-internal + url + (lambda () + (json-read-from-string (decode-coding-string (buffer-string) 'utf-8))) + decompression + with-header)) + +(defun fediorg-url-fetch-internal (url buffer-processor decompression with-header) + "Fetch from URL and process the response with BUFFER-PROCESSOR. + +With nonnil DECOMPRESSION, gunzip the response first. +With nonnil WITH-HEADER, include the response headers in the return value." + (with-current-buffer (get-buffer-create fediorg-client-buffer-name) + (goto-char (point-max)) + (insert "[" (current-time-string) "] Request: " url "\n")) + (with-current-buffer (url-retrieve-synchronously url t) + (let ((header (fediorg-kill-http-header)) (status) (fields)) + (goto-char (point-min)) + (setq header (fediorg-parse-http-header header) + status (alist-get 'status header) + fields (alist-get 'fields header)) + (with-current-buffer fediorg-client-buffer-name + (insert "[" (current-time-string) "] Response: " status "\n")) + (when decompression + (call-process-region (point) (point-max) "gunzip" t t t) + (goto-char (point-min))) + (call-interactively 'delete-trailing-whitespace) + (if (string= status "200") + (unless (= (point) (point-max)) + (if with-header + (list + (cons 'header fields) + (cons 'json (funcall buffer-processor))) + (funcall buffer-processor))) + (error "HTTP error: %s" (buffer-substring (point) (point-max))))))) + +(defun fediorg-kill-http-header () + "Kill http headers in the current buffer." + (fediorg-skip-http-header) + (let ((killed (buffer-substring-no-properties (point-min) (point)))) + (delete-region (point-min) (point)) + killed)) + +(defun fediorg-skip-http-header () + "Skip http headers in the current buffer." + (goto-char (point-min)) + (re-search-forward "\r?\n\r?\n")) + +(defun fediorg-parse-http-header (text) + "Parse http headers from TEXT in the current buffer." + (let ((status) (fields)) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (re-search-forward "^HTTP.*\\([0-9]\\{3\\}\\).*$") + (setq status (match-string 1)) + (while (re-search-forward "^\\(.*?\\): \\(.*\\)$" nil t) + (push (cons (intern (match-string 1)) (match-string 2)) fields))) + (list (cons 'status status) (cons 'fields fields)))) + +;;; utilities +(defun fediorg-api-search (host url) + (fediorg-url-fetch-json + (format "https://%s/api/v2/search/?q=%s&resolve=true" host url))) + +(defun fediorg-canonical-post-url-by-search (host url) + (let-alist (fediorg-api-search host url) + (if (seq-empty-p .statuses) + (error "No statuses associated with URL %s" url) + (fediorg-canonical-post-url (alist-get 'url (elt .statuses 0)) t)))) + +(defun fediorg-post-url-p (url &optional no-fetch) + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj)) + (host (url-host urlobj))) + (or (string-match-p "^/objects/[-a-f0-9]+$" path) + (string-match-p + "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" path) + (string-match-p "^/@[^/]+/\\([0-9]+\\)$" path) + (string-match-p "^/notice/\\([[:alnum:]]+\\)$" path)))) + +(defun fediorg-canonical-post-url (url &optional no-fetch) + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj)) + (host (url-host urlobj))) + (cond ((or (string-match-p "^/objects/[-a-f0-9]+$" path) + (string-match-p + "^/user[s]?/[[:alnum:]_]+/statuses/[[:digit:]]+$" path)) + (unless no-fetch (fediorg-canonical-post-url-by-search host url))) + ((or (string-match-p "^/@[^/]+/\\([0-9]+\\)$" path) + (string-match-p "^/notice/\\([[:alnum:]]+\\)$" path)) + url) + (t (error "Unrecognisable URL: %s" url))))) + +(defun fediorg-parse-url (url) + "Parse fedi post URL." + (pcase-let* ((urlobj (url-generic-parse-url url)) + (`(,path . _) (url-path-and-query urlobj)) + (host (url-host urlobj))) + (cons host (caddr (split-string path "/"))))) + +(defun fediorg-api-status (url) + "Get the status given URL." + (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url))) + (fediorg-url-fetch-json + (format "https://%s/api/v1/statuses/%s" host post-id)))) + +(defun fediorg-api-status-context (url) + "Get the status context given URL." + (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url))) + (fediorg-url-fetch-json + (format "https://%s/api/v1/statuses/%s/context" host post-id)))) + +(defun fediorg-get-first-ancestor (url) + "Given a fedi post URL, return the url of its first ancestor." + (let ((ancestors + (alist-get 'ancestors (fediorg-api-status-context url)))) + (if (length> ancestors 0) + (alist-get 'url (elt ancestors 0)) + url))) + +(defun fediorg-post-make-parent-fn (posts) + "Given a collection of POSTS, return a function that find the parent post." + (lambda (post) + (let ((id (alist-get 'in_reply_to_id post))) + (seq-find + (lambda (candidate) + (equal (alist-get 'id candidate) id)) + posts)))) + +;;; Formatting functions +(defun fediorg-format-post-tree (url) + "Format a post tree of post located at URL. + +Including ancestors and descendants, if any." + (let* ((posts-hier (hierarchy-new)) + (context-posts (fediorg-api-status-context url)) + (posts (vconcat + (alist-get 'ancestors context-posts) + (vector (fediorg-api-status url)) + (alist-get 'descendants context-posts)))) + (hierarchy-add-trees + posts-hier + posts + (fediorg-post-make-parent-fn posts)) + (string-join + (hierarchy-map 'fediorg-format-post posts-hier 1) + "\n"))) + +(defun fediorg-make-org-link (link desc) + (format "[[%s][%s]]" link desc)) + +(defun fediorg-format-attached (attachments host) + (mapconcat + (lambda (attachment) + (let-alist attachment + (with-temp-buffer + (insert + (fediorg-make-org-link .url .type)) + (when .description + (insert ": " .description)) + (when .preview_url + (let ((thumb-file-name + (file-name-concat + fediorg-dir + (format "%s.%s.%s" host .id + (file-name-extension .preview_url))))) + (ignore-error 'file-already-exists + (url-copy-file .preview_url thumb-file-name)) + (insert "\n") + (when-let ((image (create-image thumb-file-name))) + (insert-image image)) + )) + (buffer-string)))) + attachments + "\n")) + +(defun fediorg-format-post (post level) + "Format a POST with indent LEVEL." + (let-alist post + (let ((host (car (fediorg-parse-url .url)))) + (format "%s %s (@%s@%s) %s\n\n%s%s\n\n⤷%d ⇆%d ★%d\n" + (make-string level ?*) + (if (string-empty-p .account.display_name) + .account.username .account.display_name) + .account.username + host + (fediorg-make-org-link + .url + (fediorg--relative-time-description .created_at)) + (with-temp-buffer + (insert .content) + (shr-render-region (point-min) (point-max)) + (buffer-substring-no-properties (point-min) (point-max))) + (fediorg-format-attached .media_attachments host) + .replies_count + .reblogs_count + .favourites_count)))) + +(defun fediorg-save-text-and-switch-to-buffer (text file-name) + "Save TEXT to FILE-NAME and switch to buffer." + (let ((buffer (find-file-noselect file-name)) + (coding-system-for-write 'utf-8)) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert text)) + (goto-char (point-min)) + (save-buffer) + (revert-buffer t t)) + (switch-to-buffer buffer))) + +(defvar fediorg-dir (locate-user-emacs-file "fediorg") + "Path to local directory of saved threads.") + +(defun fediorg-make-post-file-name (url) + (pcase-let ((`(,host . ,post-id) (fediorg-parse-url url))) + (format "%s.%s.org" host post-id))) + +;;;###autoload +(defun fediorg-open (url) + "Given a fedi post URL, open an org buffer rendering the post. + +Including the context, i.e. ancestors and descendant posts." + (interactive "sPost URL: ") + (setq url (fediorg-canonical-post-url url)) + (fediorg-save-text-and-switch-to-buffer + (fediorg-format-post-tree url) + (file-name-concat fediorg-dir (fediorg-make-post-file-name url)))) + +;;; code adapted from mastodon.el +(defun fediorg--human-duration (seconds &optional resolution) + "Return a string describing SECONDS in a more human-friendly way. +The return format is (STRING . RES) where RES is the resolution of +this string, in seconds. +RESOLUTION is the finest resolution, in seconds, to use for the +second part of the output (defaults to 60, so that seconds are only +displayed when the duration is smaller than a minute)." + (cl-assert (>= seconds 0)) + (unless resolution (setq resolution 60)) + (let* ((units fediorg--time-units) + (n1 seconds) (unit1 (pop units)) (res1 1) + n2 unit2 res2 + next) + (while (and units (> (truncate (setq next (/ n1 (car units)))) 0)) + (setq unit2 unit1) + (setq res2 res1) + (setq n2 (- n1 (* (car units) (truncate n1 (car units))))) + (setq n1 next) + (setq res1 (truncate (* res1 (car units)))) + (pop units) + (setq unit1 (pop units))) + (setq n1 (truncate n1)) + (if n2 (setq n2 (truncate n2))) + (cond + ((null n2) + ;; revert to old just now style for < 1 min: + (cons "just now" 60)) + ;; (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) + ;; (max resolution res1))) + ((< (* res2 n2) resolution) + (cons (format "%d %s%s" n1 unit1 (if (> n1 1) "s" "")) + (max resolution res2))) + ((< res2 resolution) + (let ((n2 (/ (* resolution (/ (* n2 res2) resolution)) res2))) + (cons (format "%d %s%s, %d %s%s" + n1 unit1 (if (> n1 1) "s" "") + n2 unit2 (if (> n2 1) "s" "")) + resolution))) + (t + (cons (format "%d %s%s, %d %s%s" + n1 unit1 (if (> n1 1) "s" "") + n2 unit2 (if (> n2 1) "s" "")) + (max res2 resolution)))))) + +(defconst fediorg--time-units + '("sec" 60.0 ;; Use a float to convert `n' to float. + "min" 60 + "hour" 24 + "day" 7 + "week" 4.345 + "month" 12 + "year")) + +(defun fediorg--relative-time-details (timestamp &optional current-time) + "Return cons of (DESCRIPTIVE STRING . NEXT-CHANGE) for the TIMESTAMP. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +The descriptive string is a human readable version relative to +the current time while the next change timestamp give the first +time that this description will change in the future. +TIMESTAMP is assumed to be in the past." + (let* ((time-difference (time-subtract current-time timestamp)) + (seconds-difference (float-time time-difference)) + (tmp (fediorg--human-duration (max 0 seconds-difference)))) + ;; revert to old just now style for < 1 min + (cons (concat (car tmp) (if (string= "just now" (car tmp)) "" " ago")) + (time-add current-time (cdr tmp))))) + +(defun fediorg--relative-time-description (time-string &optional current-time) + "Return a string with a human readable TIME-STRING relative to the current time. +Use the optional CURRENT-TIME as the current time (only used for +reliable testing). +E.g. this could return something like \"1 min ago\", \"yesterday\", etc. +TIME-STAMP is assumed to be in the past." + (car (fediorg--relative-time-details + (encode-time (parse-time-string time-string)) current-time))) + +(provide 'fediorg) +;;; fediorg.el ends here diff --git a/emacs/.emacs.d/lisp/my/infobox.el b/emacs/.emacs.d/lisp/my/infobox.el new file mode 100644 index 0000000..ff4adb6 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/infobox.el @@ -0,0 +1,174 @@ +;;; 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-transform-field-value (v) + (cond ((stringp v) v) + ((eq v t) "YES") + ((eq v :json-false) "NO") + ((seqp v) + (mapconcat + (lambda (x) (if (stringp x) x (prin1-to-string x))) + v + ", ")) + (t (format "%s" v)))) + +(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) (infobox-transform-field-value 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)) + ;; TODO: use a more standard function than + ;; `my-make-filename-from-url' + (when-let* ((thumb-url (alist-get "Thumbnail" info nil nil 'equal)) + (file-name + (if (string-prefix-p "file://" thumb-url) + (string-remove-prefix "file://" thumb-url) + (make-temp-name "/tmp/infobox-")))) + (unless (string-prefix-p "file://" thumb-url) + (url-copy-file thumb-url file-name t)) + (insert-image (create-image file-name nil nil + :max-width (window-pixel-width) + :max-height (/ (window-pixel-height) 2))) + (insert "\n") + (setq n-rows (1+ n-rows)) + (setq info (assoc-delete-all "Thumbnail" info)) + ) + (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) + (goto-char (point-min)) + (flush-lines "ExifTool Version") + (end-of-line) + (insert " -- " (buttonize + "xdg-open" + (lambda (_) (call-process "xdg-open" nil 0 nil filename))) + " " (buttonize "find-file" (lambda (_) (find-file filename)))) + (buffer-string)) + `(infobox-exiftool ,filename) + (called-interactively-p 'interactive) + )) + +(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")))) + +(provide 'infobox) diff --git a/emacs/.emacs.d/lisp/my/mastorg.el b/emacs/.emacs.d/lisp/my/mastorg.el deleted file mode 100644 index 3544b2e..0000000 --- a/emacs/.emacs.d/lisp/my/mastorg.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; mastorg.el -- Read or archive mastodon toot context in org mode -*- lexical-binding: t -*- - -;; Copyright (C) 2023 Free Software Foundation, Inc. - -;; Author: Yuchen Pei <id@ypei.org> -;; Package-Requires: ((emacs "28.2")) - -;; 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: - -;; Read or archive mastodon toot context in org mode. This is a -;; standalone library, and can be used without any other files in this -;; project. - -;; Usage: -;; M-x mastorg-open <RET> https://mastodon.instance/@user/12345678901234 <RET> -;; -;; The toot, together with its ancestors and descendants, subject to -;; mastodon API depth limit, are displayed in an org buffer. - -;; TODO: -;; -;; To be able to refresh the org buffer at an org entry, which would -;; re-fetch the context of the corresponding toot and upsert them in -;; the buffer. -;;; Code: - - -(require 'hierarchy) -(require 'json) -(require 'url-parse) - -(defvar mastorg-buffer "*mastorg*" "Buffer name for mastorg buffers.") - -;;; Fetching utilities -(defvar mastorg-client-buffer-name "*mastorg-api*" - "Buffer name for logging API requests.") - -(defun mastorg-url-fetch-json (url &optional decompression with-header) - "Fetch and parse json from URL. - -With nonnil DECOMPRESSION, gunzip the response first. -With nonnil WITH-HEADER, include the response headers in the return value." - (mastorg-url-fetch-internal - url - (lambda () - (json-read-from-string (decode-coding-string (buffer-string) 'utf-8))) - decompression - with-header)) - -(defun mastorg-url-fetch-internal (url buffer-processor decompression with-header) - "Fetch from URL and process the response with BUFFER-PROCESSOR. - -With nonnil DECOMPRESSION, gunzip the response first. -With nonnil WITH-HEADER, include the response headers in the return value." - (with-current-buffer (get-buffer-create mastorg-client-buffer-name) - (goto-char (point-max)) - (insert "[" (current-time-string) "] Request: " url "\n")) - (with-current-buffer (url-retrieve-synchronously url t) - (let ((header (mastorg-kill-http-header)) (status) (fields)) - (goto-char (point-min)) - (setq header (mastorg-parse-http-header header) - status (alist-get 'status header) - fields (alist-get 'fields header)) - (with-current-buffer mastorg-client-buffer-name - (insert "[" (current-time-string) "] Response: " status "\n")) - (when decompression - (call-process-region (point) (point-max) "gunzip" t t t) - (goto-char (point-min))) - (call-interactively 'delete-trailing-whitespace) - (if (string= status "200") - (unless (= (point) (point-max)) - (if with-header - (list - (cons 'header fields) - (cons 'json (funcall buffer-processor))) - (funcall buffer-processor))) - (error "HTTP error: %s" (buffer-substring (point) (point-max))))))) - -(defun mastorg-kill-http-header () - "Kill http headers in the current buffer." - (mastorg-skip-http-header) - (let ((killed (buffer-substring-no-properties (point-min) (point)))) - (delete-region (point-min) (point)) - killed)) - -(defun mastorg-skip-http-header () - "Skip http headers in the current buffer." - (goto-char (point-min)) - (re-search-forward "\r?\n\r?\n")) - -(defun mastorg-parse-http-header (text) - "Parse http headers from TEXT in the current buffer." - (let ((status) (fields)) - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (re-search-forward "^HTTP.*\\([0-9]\\{3\\}\\).*$") - (setq status (match-string 1)) - (while (re-search-forward "^\\(.*?\\): \\(.*\\)$" nil t) - (push (cons (intern (match-string 1)) (match-string 2)) fields))) - (list (cons 'status status) (cons 'fields fields)))) - -;;; mastodon utilities -(defun mastorg-parse-url (url) - "Parse mastodon post URL." - (pcase-let* ((urlobj (url-generic-parse-url url)) - (`(,path . _) (url-path-and-query urlobj)) - (host (url-host urlobj))) - (cons host (caddr (split-string path "/"))))) - -(defun mastorg-api-status (url) - "Get the status given URL." - (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url))) - (mastorg-url-fetch-json - (format "https://%s/api/v1/statuses/%s" host post-id)))) - -(defun mastorg-api-status-context (url) - "Get the status context given URL." - (pcase-let ((`(,host . ,post-id) (mastorg-parse-url url))) - (mastorg-url-fetch-json - (format "https://%s/api/v1/statuses/%s/context" host post-id)))) - -(defun mastorg-get-first-ancestor (url) - "Given a mastodon URL, return the url of its first ancestor." - (let ((ancestors - (alist-get 'ancestors (mastorg-api-status-context url)))) - (if (length> ancestors 0) - (alist-get 'url (elt ancestors 0)) - url))) - -(defun mastorg-toot-make-parent-fn (toots) - "Given a collection of TOOTS, return a function that find the parent toot." - (lambda (toot) - (let ((id (alist-get 'in_reply_to_id toot))) - (seq-find - (lambda (candidate) - (equal (alist-get 'id candidate) id)) - toots)))) - -;;; Formatting functions -(defun mastorg-format-toot-tree (url) - "Format a toot tree of toot located at URL. - -Including ancestors and descendants, if any." - (let* ((toots-hier (hierarchy-new)) - (context-toots (mastorg-api-status-context url)) - (toots (vconcat - (alist-get 'ancestors context-toots) - (vector (mastorg-api-status url)) - (alist-get 'descendants context-toots)))) - (hierarchy-add-trees - toots-hier - toots - (mastorg-toot-make-parent-fn toots)) - (string-join - (hierarchy-map 'mastorg-format-toot toots-hier 1) - "\n"))) - -(defun mastorg-format-toot (toot level) - "Format a TOOT with indent LEVEL." - (pcase-let* ((url (alist-get 'url toot)) - (account (alist-get 'account toot)) - (display-name (alist-get 'display_name account)) - (username (alist-get 'username account)) - (`(,host . _) (mastorg-parse-url url))) - (format "%s %s @%s@%s %s\n%s" - (make-string level ?*) - (if (string-empty-p display-name) username display-name) - username - host - (alist-get 'created_at toot) - (with-temp-buffer - (insert (alist-get 'content toot)) - (shr-render-region (point-min) (point-max)) - (buffer-substring-no-properties (point-min) (point-max)))))) - -;;;###autoload -(defun mastorg-open (url) - "Given a mastodon toot URL, open an org buffer rendering the toot. - -Including the context, i.e. ancestors and descendant toots." - (interactive "sToot URL: ") - (with-current-buffer (get-buffer-create mastorg-buffer) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (mastorg-format-toot-tree url)) - (org-mode) - (goto-char (point-min)))) - (switch-to-buffer mastorg-buffer)) - -(provide 'mastorg) -;;; mastorg.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-buffer.el b/emacs/.emacs.d/lisp/my/my-buffer.el index ef988f8..a8683de 100644 --- a/emacs/.emacs.d/lisp/my/my-buffer.el +++ b/emacs/.emacs.d/lisp/my/my-buffer.el @@ -239,12 +239,52 @@ that point." (setq buffer temp-buffer)) (set-window-buffer first-window buffer))) -(defun my-focus-write () - "Make the current window the only one centered with width 80." +(defun my-set-left-buffer () + "Generate and switch to an empty buffer." (interactive) - (delete-other-windows) - (let ((margin (/ (- (window-width) 80) 2))) - (set-window-margins nil margin margin))) + (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. Make +buffers on both sides empty read-only buffers." + (interactive) + (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)) + (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." @@ -403,6 +443,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 @@ -458,5 +503,28 @@ With double prefix arguments, create a new indirect buffer." (4 (my-switch-indirect-buffer)) (_ (my-cycle-indirect-buffer)))) +(defun my-save-text-and-switch-to-buffer (text file-name) + "Save TEXT to FILE-NAME and switch to buffer." + (let ((buffer (find-file-noselect file-name)) + (coding-system-for-write 'utf-8)) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert text)) + (goto-char (point-min)) + (save-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-consult-recoll.el b/emacs/.emacs.d/lisp/my/my-consult-recoll.el new file mode 100644 index 0000000..1754ad4 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-consult-recoll.el @@ -0,0 +1,3 @@ +(defun my-consult-recoll-open-in-pdf-tools (filename &optional page) + (find-file filename) + (when page (pdf-view-goto-page page))) diff --git a/emacs/.emacs.d/lisp/my/my-dired.el b/emacs/.emacs.d/lisp/my/my-dired.el index 83607ab..2fdbfa9 100644 --- a/emacs/.emacs.d/lisp/my/my-dired.el +++ b/emacs/.emacs.d/lisp/my/my-dired.el @@ -109,15 +109,24 @@ With a prefix arg, toggle `my-dired-reverse-sorting' instead." "Empty the xdg trash" (interactive) (let* ((xdg-data-dir - (directory-file-name - (expand-file-name "Trash" - (or (getenv "XDG_DATA_HOME") - "~/.local/share")))) - (trash-files-dir (expand-file-name "files" xdg-data-dir)) - (trash-info-dir (expand-file-name "info" xdg-data-dir))) + (directory-file-name + (expand-file-name "Trash" + (or (getenv "XDG_DATA_HOME") + "~/.local/share")))) + (trash-files-dir (expand-file-name "files" xdg-data-dir)) + (trash-info-dir (expand-file-name "info" xdg-data-dir))) (delete-directory trash-files-dir t) (delete-directory trash-info-dir t))) +(defun my-dired-jump-xdg-trash () + "Open the xdg trash dir in dired." + (interactive) + (dired + (directory-file-name + (expand-file-name "Trash" + (or (getenv "XDG_DATA_HOME") + "~/.local/share"))))) + (defun my-dired-do-delete (delete-fun &optional arg) "Wrapper of `dired-do-delete'. diff --git a/emacs/.emacs.d/lisp/my/my-editing.el b/emacs/.emacs.d/lisp/my/my-editing.el index aa65ba1..e6499ff 100644 --- a/emacs/.emacs.d/lisp/my/my-editing.el +++ b/emacs/.emacs.d/lisp/my/my-editing.el @@ -90,7 +90,7 @@ (interactive) (zap-up-to-char -1 ?/)) -(defun my-toggle-forward-word-viper-symbol () +(defun my-toggle-forward-word-symbol () (interactive) (require 'viper) (cond ((eq (lookup-key (current-global-map) "\M-f") 'forward-word) @@ -102,14 +102,47 @@ (progn (define-key global-map "\M-f" 'forward-symbol) (define-key global-map "\M-b" - (lambda () (interactive) - (forward-symbol -1))) + (lambda () (interactive) + (forward-symbol -1))) (message "M-f is forward-symbol"))) (t (progn (define-key global-map "\M-f" 'forward-word) (define-key global-map "\M-b" 'backward-word) (message "M-f is forward-word"))))) +;;; todo: move to my-viper +;;; do not skip underscore +(defun viper-forward-word-kernel (val) + (while (> val 0) + (cond ((viper-looking-at-alpha) + (viper-skip-alpha-forward "") + (viper-skip-separators t)) + ((viper-looking-at-separator) + (viper-skip-separators t)) + ((not (viper-looking-at-alphasep)) + (viper-skip-nonalphasep-forward) + (viper-skip-separators t))) + (setq val (1- val)))) + +(defun viper-backward-word-kernel (val) + (while (> val 0) + (viper-backward-char-carefully) + (cond ((viper-looking-at-alpha) + (viper-skip-alpha-backward "")) + ((viper-looking-at-separator) + (forward-char) + (viper-skip-separators nil) + (viper-backward-char-carefully) + (cond ((viper-looking-at-alpha) + (viper-skip-alpha-backward "_")) + ((not (viper-looking-at-alphasep)) + (viper-skip-nonalphasep-backward)) + ((bobp)) ; could still be at separator, but at beg of buffer + (t (forward-char)))) + ((not (viper-looking-at-alphasep)) + (viper-skip-nonalphasep-backward))) + (setq val (1- val)))) + (defun my--duplicate-buffer-substring (beg end &optional indent) "Duplicate buffer substring between BEG and END positions. With optional INDENT, run `indent-for-tab-command' after @@ -495,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)))) @@ -513,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))) @@ -525,5 +579,16 @@ With an prefix-arg, copy the file name relative to project root." (defun my-turn-off-truncate-lines () (setq truncate-lines nil)) +(defun my-write-file () + "Same as `write-file', but keep the old buffer and remain there. + +In other words, create a new buffer with the same content and +execute `write-file', then switch back to the current buffer." + (interactive) + (let ((old-buffer (current-buffer))) + (with-temp-buffer + (insert-buffer-substring old-buffer) + (call-interactively 'write-file)))) + (provide 'my-editing) ;;; my-editing.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-emms.el b/emacs/.emacs.d/lisp/my/my-emms.el index fa0ae17..e8be5ee 100644 --- a/emacs/.emacs.d/lisp/my/my-emms.el +++ b/emacs/.emacs.d/lisp/my/my-emms.el @@ -139,7 +139,7 @@ (mapc 'my-emms-load-from-native my-emms-native-playlists) (emms-metaplaylist-mode-go)) -(defun my-emms-deduplicate () +(defun my-emms-playlist-deduplicate () (interactive) (emms-mark-regexp ".* ([0-9])\\.[a-zA-Z0-9]+" nil) (emms-mark-delete-marked-tracks)) @@ -159,6 +159,16 @@ either 'audio or 'video (alist-get type my-extension-types))) (with-current-buffer to (emms-sort)))) +(defun my-emms-players-preference (track players) + "If audio, use first player, otherwise second." + (let ((name (emms-track-name track))) + (if (and (length> players 1) + (string-prefix-p "file://" name) + (member (file-name-extension name) + '("mkv" "ogv" "avi" "webm"))) + 'emms-player-vlc + 'emms-player-mpv))) + (defvar my-emms-playlist-alist nil "alist controlling playlists, where the cdr of each item is an also an alist, with possible keys 'source and 'type. @@ -290,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)))) @@ -351,17 +374,20 @@ filter extensions from filter-exts." my-emms-favourites-playlist))) ;;; random album in emms -(defun my-my-emms-current-album-name () +(defun my-emms-current-album-name () (file-name-directory (my-emms-get-current-track-name))) +(defun my-emms-playlist-album-name-at-point () + (file-name-directory (emms-track-get (emms-playlist-track-at) 'name))) + (defun my-emms-next-track-or-random-album () (interactive) - (let ((current-album (my-my-emms-current-album-name))) + (let ((current-album (my-emms-current-album-name))) (when emms-player-playing-p (emms-stop)) (emms-playlist-current-select-next) - (if (string-equal (my-my-emms-current-album-name) current-album) + (if (string-equal (my-emms-current-album-name) current-album) (emms-start) - (my-emms-random-album nil)))) + (my-emms-playlist-random-album)))) (defvar-local my-emms-albums-cache (vector)) @@ -392,20 +418,145 @@ under /zzz-seren/." (elt my-emms-albums-cache (random (length my-emms-albums-cache))))) album)) -(defun my-emms-random-album (update-album) - (interactive "P") +(defun my-emms-playlist-random-album () + (interactive) (with-current-emms-playlist - (when (or update-album (length= my-emms-albums-cache 0)) - (my-emms-save-albums-cache)) - (when emms-player-playing-p (emms-stop)) - (let ((saved-position (point))) - (goto-char (point-min)) - (if (search-forward - (my-emms-get-random-album) - nil t) - (emms-playlist-mode-play-current-track) - (goto-char saved-position) - (error "Cannot play random album"))))) + (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 @@ -463,13 +614,79 @@ 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 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. + +If the last command is `emms-playlist-mode-play-smart', then set +`my-emms-score-delta' to 2." + (if (not (eq last-command 'emms-playlist-mode-play-smart)) + (setq my-emms-score-delta 1) + (setq my-emms-score-delta 2) + (setq last-command nil)) + ) + +(defun my-emms-wrapped () + "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 10: %s" (string-join (take 10 keys) "\n")))) + +(defun my-emms-maybe-get-duration-for-current-track () + "Get duration for the current track. + +Can be used as a `emms-player-started-hook'" + (unless (emms-track-get (emms-playlist-current-selected-track) + 'info-playing-time) + (my-emms-info-ffprobe (emms-playlist-current-selected-track)))) + +(defun my-emms-info-ffprobe (track) + "Use ffprobe for urls to get duration. + +Call + +ffprobe -v error -show_entries format=duration -of default=noprint_wrappers=1:nokey=1 + +on the url" + (when (eq (emms-track-type track) 'url) + (with-temp-buffer + (call-process "ffprobe" nil t nil "-v" "error" "-show_entries" + "format=duration" "-of" "default=noprint_wrappers=1:nokey=1" + (emms-track-name track)) + (let ((duration (string-trim (buffer-string)))) + (when (string-match-p "[0-9.]+" duration) + (emms-track-set track 'info-playing-time + (floor (string-to-number duration)))))))) + (provide 'my-emms) ;;; my-emms.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-epub.el b/emacs/.emacs.d/lisp/my/my-epub.el new file mode 100644 index 0000000..4a3dfca --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-epub.el @@ -0,0 +1,75 @@ +;;; my-epub.el -- epub utils -*- lexical-binding: t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "30.1")) + +;; This file is part of dotted. + +;; dotted is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; dotted is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +;; Public License for more details. + +;; You should have received a copy of the GNU Affero General Public +;; License along with dotted. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; epub utils. + +;;; Code: + + +(defun my-epub-content-file-name (file-name) + (with-temp-buffer + (if (eq 0 (call-process "unzip" nil t nil + "-p" file-name "META-INF/container.xml")) + (let ((dom (libxml-parse-xml-region (point-min) (point-max)))) + (dom-attr + (dom-by-tag + (dom-by-tag (dom-by-tag dom 'container) 'rootfiles) + 'rootfile) + 'full-path)) + (message "Failed to extract container.xml: %s" (buffer-string)) + nil))) + +(defun my-epub-metadata (file-name) + "Get metadata of an epub file." + (when-let ((content-file-name (my-epub-content-file-name file-name))) + (with-temp-buffer + (call-process "unzip" nil t nil "-p" file-name content-file-name) + (let* ((dom (libxml-parse-xml-region (point-min) (point-max))) + (metadata (dom-by-tag dom 'metadata)) + (title (dom-text (dom-by-tag metadata 'title))) + (authors (dom-texts (dom-by-tag metadata 'creator) ", ")) + (identifier + (replace-regexp-in-string + "[^0-9,]" "" + (dom-texts + (seq-filter + (lambda (node) + (or (equal "ISBN" (dom-attr node 'scheme)) + (string-match-p "^[0-9]+$" (dom-text node)))) + (dom-by-tag metadata 'identifier)) + ","))) + (date (replace-regexp-in-string + "[^0-9]" "" + (dom-text (dom-by-tag metadata 'date)))) + (year (substring date 0 (min 4 (length date))))) + `((title . ,title) + (authors . ,authors) + (year . ,year) + (identifier . ,identifier)) + ;; (pp metadata) + )) + )) + +(provide 'my-epub) +;;; my-epub.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-github.el b/emacs/.emacs.d/lisp/my/my-github.el index 45adcf6..e2d5f6a 100644 --- a/emacs/.emacs.d/lisp/my/my-github.el +++ b/emacs/.emacs.d/lisp/my/my-github.el @@ -25,7 +25,7 @@ ;; Github client. ;;; Code: - +(require 'my-web) (defun my-grok-github (url) "get github info of a project. @@ -54,6 +54,60 @@ 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-url-p (url) + (let ((urlobj (url-generic-parse-url url))) + (string-match-p "\\(www\\.\\)?github.com" (url-host urlobj)))) + +(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 . ("URL" . my-forge-infobox-format-url)) + (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..56542c0 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,77 @@ (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) +(require 'my-web) +(require 'my-magit) + +(defvar my-gitlab-project-info-specs + `((http_url_to_repo . ("URL" . my-forge-infobox-format-url)) + (name_with_namespace . "Name") + (description . "Description") + (created_at . ("Created at" . my-gitlab-format-time-string)) + (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-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el index e44e9c8..6a2142b 100644 --- a/emacs/.emacs.d/lisp/my/my-gnus.el +++ b/emacs/.emacs.d/lisp/my/my-gnus.el @@ -162,7 +162,7 @@ The archiving target comes from `my-gnus-group-alist'." "The default inbox to be opened with `my-gnus-open-inbox'.") (defun my-gnus-open-inbox () (interactive) - (gnus-group-read-group t nil my-gnus-inbox-group)) + (gnus-group-read-group 200 t my-gnus-inbox-group)) (defun my-gnus-start () (interactive) diff --git a/emacs/.emacs.d/lisp/my/my-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 92a6b61..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) @@ -144,32 +146,116 @@ (alist-get 'extension info)))) (defvar my-libgen-download-dir "~/Downloads") -(defun my-libgen-download-action () + +(defvar my-libgen-onion-host nil) +(defun my-libgen-make-download-link-library (info) + (car (link-gopher-get-all-links + (format "%s/main/%s" my-libgen-library-host + (alist-get 'md5 info)) + (format "\\.%s$" (alist-get 'extension info))))) + +(defun my-libgen-make-download-link-onion (info) + (let ((id-head (substring (alist-get 'id info) 0 -3))) + (format "%s/LG/%s%s/%s" + my-libgen-onion-host + (make-string (- 4 (length id-head)) ?0) + id-head + (downcase (alist-get 'md5 info))))) + +(defun my-libgen-plus-get-download-url (info) + (let-alist info + (file-name-concat + my-libgen-plus-host + (dom-attr + (dom-search + (my-url-fetch-dom (format "%s/ads.php?md5=%s" my-libgen-plus-host .md5)) + (lambda (n) + (string-match (format "get\\.php\\?md5=%s" .md5) + (or (dom-attr n 'href) "")))) + 'href)))) + +(defun my-libgen-plus-download-action () + (interactive) + (let* ((info (get-text-property (point) 'button-data)) + (filename (file-name-concat (expand-file-name my-libgen-download-dir) + (my-libgen-format-filename info))) + (md5 (alist-get 'md5 info))) + (my-wget-async + (my-libgen-plus-get-download-url info) + filename + nil + (lambda () (my-libgen-check-md5 filename md5))))) + +(defun my-libgen-plus-edition-infobox (edition-id) + (let ((dom (my-url-fetch-dom + (format "%s/edition.php?id=%s" my-libgen-plus-host edition-id)))) + (infobox-render-string + (with-temp-buffer + (insert (mapconcat (lambda (p) (dom-texts p "")) + (dom-by-tag (dom-by-class dom "order-2") 'p) "\n")) + (shr-insert-document (dom-by-class dom "order-5")) + (buffer-string)) + `(my-libgen-plus-edition-infobox ,edition-id) + (called-interactively-p 'interactive) + ) + )) + +(defun my-libgen-plus-infobox-action () + (interactive) + (my-libgen-plus-edition-infobox + (alist-get 'edition-id (get-text-property (point) 'button-data)))) + +(defun my-libgen-check-md5 (file md5) + (let ((actual (substring (my-call-process-out "md5sum" file) 0 32))) + (unless (equal actual md5) + (warn "MD5 checksum of %s mismatch: should be %s but actually %s" + file md5 actual)))) + +(defun my-libgen-download-library-action () + (interactive) + (let* ((info (get-text-property (point) 'button-data)) + (filename (file-name-concat (expand-file-name my-libgen-download-dir) + (my-libgen-format-filename info))) + (md5 (alist-get 'md5 info))) + (my-wget-async + (my-libgen-make-download-link-library info) + filename + nil + (lambda () (my-libgen-check-md5 filename md5))))) + +(defun my-libgen-download-onion-action () (interactive) (let ((info (get-text-property (point) 'button-data))) (my-wget-async - (car (link-gopher-get-all-links - (format "%s/main/%s" my-libgen-library-host - (alist-get 'md5 info)) - (format "\\.%s$" (alist-get 'extension info)))) + (my-libgen-make-download-link-onion info) (format "%s/%s" (expand-file-name my-libgen-download-dir) (my-libgen-format-filename info))))) (defvar my-libgen-button-keymap (let ((kmap (make-sparse-keymap))) (set-keymap-parent kmap button-map) - (define-key kmap "d" 'my-libgen-download-action) + (define-key kmap "d" 'my-libgen-download-library-action) + (define-key kmap "t" 'my-libgen-download-onion-action) (define-key kmap "p" 'my-libgen-show-more-info) kmap)) +(defvar my-libgen-plus-button-keymap + (let ((kmap (make-sparse-keymap))) + (set-keymap-parent kmap button-map) + (define-key kmap "d" 'my-libgen-plus-download-action) + (define-key kmap "i" 'my-libgen-plus-infobox-action) + ;; (define-key kmap "t" 'my-libgen-download-onion-action) + ;; (define-key kmap "p" 'my-libgen-show-more-info) + kmap)) + (defun my-libgen-show-more-info () (interactive) (pp (my-grok-libgen-make-info - (elt - (my-libgen-api-by-id - (alist-get 'id - (get-text-property (point) 'button-data))) - 0)))) + (elt + (my-libgen-api-by-id + (alist-get 'id + (get-text-property (point) 'button-data))) + 0)))) (defun my-libgen-search-isbn (isbn) (interactive "sISBN: ") @@ -195,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" @@ -205,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))) @@ -238,5 +418,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-magit.el b/emacs/.emacs.d/lisp/my/my-magit.el index efb3c84..eabed05 100644 --- a/emacs/.emacs.d/lisp/my/my-magit.el +++ b/emacs/.emacs.d/lisp/my/my-magit.el @@ -32,23 +32,26 @@ (require 'my-project) (require 'org) -(defun my-magit-clone-org-source (arg) - (interactive "P") - (let* ((url (or (org-entry-get (point) "Source") - (org-entry-get (point) "Website"))) - (default-base-dir - (alist-get "3p" my-projects-root-dirs nil nil 'string=)) +(defun my-magit-clone (url prefix-arg) + (let* ((default-base-dir + (alist-get "3p" my-projects-root-dirs nil nil 'string=)) (default-name - (progn (string-match "^.*/\\(.*?\\)\\(\\.git\\)?$" url) - (match-string 1 url))) + (progn (string-match "^.*/\\(.*?\\)\\(\\.git\\)?$" url) + (match-string 1 url))) (dir (read-file-name - (if arg "Clone to: " "Shallow clone to: ") + (if prefix-arg "Clone to: " "Shallow clone to: ") (concat default-base-dir "/") nil nil default-name))) - (if arg + (if prefix-arg (magit-clone-regular url dir nil) - (magit-clone-shallow url dir nil 1)) + (magit-clone-shallow url dir nil 1)))) + +(defun my-magit-clone-org-source (arg) + (interactive "P") + (let* ((url (or (org-entry-get (point) "Source") + (org-entry-get (point) "Website")))) + (my-magit-clone url arg) (org-set-property "Local-source" (format "<file:%s>" dir)))) diff --git a/emacs/.emacs.d/lisp/my/my-mariadb.el b/emacs/.emacs.d/lisp/my/my-mariadb.el index 52ca8bc..d6c2463 100644 --- a/emacs/.emacs.d/lisp/my/my-mariadb.el +++ b/emacs/.emacs.d/lisp/my/my-mariadb.el @@ -33,7 +33,9 @@ (interactive) (if (equal (file-name-extension (buffer-file-name)) "test") - (call-interactively 'project-compile) + (progn + (my-mtr-set-compile-command) + (call-interactively 'compile)) (sql-send-buffer))) (defun my-gdb-maria () @@ -56,14 +58,14 @@ (when (and (buffer-live-p gud-comint-buffer) (get-buffer-process gud-comint-buffer)) (my-gdb-quit)) - (sleep-for 1) + ;; (sleep-for 1) (my-gdb (format "rr replay %s -d %s" (expand-file-name (replace-regexp-in-string "/src" "/build/mysql-test/var/log/mysqld.1.1.rr/latest-trace" - ;; "/build/mysql-test/var/log/mysqld.3.1.rr/latest-trace" + ;; "/build/mysql-test/var/log/mysqld.2.2.rr/latest-trace" (project-root (project-current t)))) (expand-file-name "~/bin/gdb-mi.sh")))) @@ -251,5 +253,71 @@ 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. + +The source is saved in a .wiki file under the /tmp dir, and it +switches to the buffer." + (interactive "sURL: ") + (let* ((term + (progn + (string-match "https://mariadb.com/kb/en/\\([^/]+\\)/" url) + (match-string 1 url))) + (source + (dom-text + (dom-by-id + (my-url-fetch-dom + (format "https://mariadb.com/kb/en/%s/+source/" term)) + "answer_source"))) + (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 "%s %s %s %s" + "taskset -c 0-3" + (file-name-concat build-dir "mysql-test/mtr") + test-name + "--rr"))))) + (provide 'my-mariadb) ;;; my-mariadb.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-media-segment.el b/emacs/.emacs.d/lisp/my/my-media-segment.el index 0cef817..f222316 100644 --- a/emacs/.emacs.d/lisp/my/my-media-segment.el +++ b/emacs/.emacs.d/lisp/my/my-media-segment.el @@ -63,6 +63,7 @@ Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (insert-file-contents desc-file-name) (buffer-string)))) (total (length info)) + (pad (1+ (floor (log10 total)))) (idx 0) (thunk)) (dolist (media info) @@ -74,8 +75,9 @@ Uses `my-media-segment-max-inflight' to limit number of inflight tasks." (args (append (list "-ss" start) (when end (list "-to" end)) (list "-i" (expand-file-name media-file-name) - (format "%s/%s.%s" dir title - (file-name-extension media-file-name)))))) + (format + (format "%%s/%%0%dd-%%s.%%s" pad) dir idx title + (file-name-extension media-file-name)))))) (setq thunk (lambda () (message "Cutting %s-%s to %s (%d/%d)..." diff --git a/emacs/.emacs.d/lisp/my/my-net.el b/emacs/.emacs.d/lisp/my/my-net.el index 0eafb7a..b19ce68 100644 --- a/emacs/.emacs.d/lisp/my/my-net.el +++ b/emacs/.emacs.d/lisp/my/my-net.el @@ -29,12 +29,24 @@ ;;; net utilities (defvar my-download-dir "~/Downloads") +(defvar my-webpage-download-dir "~/Downloads") -(defun my-make-file-name-from-url (url) - (file-name-nondirectory - (directory-file-name - (car (url-path-and-query (url-generic-parse-url - (url-unhex-string url))))))) +(defmacro my-url-as-googlebot (&rest body) + "Run BODY while spoofing as googlebot" + `(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)")) + ,@body)) + +(def-edebug-spec my-url-as-googlebot t) + +(defun my-make-file-name-from-url (url &optional extension) + (format "%s%s" + (file-name-nondirectory + (directory-file-name + (car (url-path-and-query (url-generic-parse-url + (url-unhex-string url)))))) + (if extension (concat "." extension) ""))) ;; stolen from `eww-make-unique-file-name' (defun my-make-unique-file-name (file directory) @@ -80,18 +92,9 @@ It checks the STATUS, and if it is ok, saves the payload to FILE-NAME." (when (plist-get status :error) (error "My fetch failed: %s" (plist-get status :error))) (my-delete-http-header) - (let ((to-insert (buffer-string)) - (buffer (find-file-noselect file-name)) - (coding-system-for-write 'utf-8)) + (let ((to-insert (buffer-string))) (kill-buffer) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert to-insert)) - (goto-char (point-min)) - (save-buffer) - (revert-buffer t t)) - (switch-to-buffer buffer)) + (my-save-text-and-switch-to-buffer to-insert file-name)) ) (defun my-kill-http-header () @@ -128,6 +131,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)) @@ -150,7 +161,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..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") @@ -52,5 +68,125 @@ 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 () + ;; Does not work as well as setq left- and right-margin-width + ;; (set-window-margins nil 3 2) + (setq left-margin-width 3) + (setq right-margin-width 2) + ;; Does not work as well as setq left- and right-fringe-width + ;; (set-window-fringes nil 0 0) + (setq left-fringe-width 0) + (setq right-fringe-width 0) + (visual-line-mode) + ) + +(defvar-local my-nov-document-word-counts nil + "Word count of each nov document.") + +(defvar-local my-nov-total-word-count nil + "Total word count of the epub.") + +(defun my-nov-count-words () + (interactive) + (unless my-nov-document-word-counts + (message "Counting words...") + (setq my-nov-document-word-counts + (apply + 'vector + (seq-map + (lambda (doc) + (with-temp-buffer + (pcase-let ((`(,name . ,file) doc)) + (insert-file-contents file) + (nov-render-html) + (cons name (count-words (point-min) (point-max)))))) + nov-documents))) + (setq my-nov-total-word-count + (seq-reduce + (lambda (sum pair) + (+ sum (cdr pair))) + my-nov-document-word-counts + 0)) + (message "Counting words...done"))) + +(defun my-nov-stats () + (interactive) + (message "%d words; %d standard pages" + my-nov-total-word-count + (ceiling (/ my-nov-total-word-count 300.0)))) + +;;; TODO: also show current percentage in the total book in the mode +;;; line +(defun my-nov-goto-nth-word (n) + "Go to the nth word of the current epub." + (my-nov-count-words) + (setq nov-documents-index -1) + (let ((found + (seq-find + (lambda (pair) + (setq n (- n (cdr pair))) + (setq nov-documents-index (1+ nov-documents-index)) + (<= n 0)) + my-nov-document-word-counts))) + (nov-render-document) + (if (> n 0) + (end-of-buffer) + (forward-word (+ n (cdr found))))) + ) + +(defun my-nov-word-position () + "Where are we in terms of word position? + +Return n, such that nth word of the epub is at the beginning of the +screen." + (my-nov-count-words) + (let ((result 0)) + (dotimes (i nov-documents-index) + (setq result (+ result (cdr (aref my-nov-document-word-counts i))))) + (save-excursion + (move-to-window-line 0) + (setq result (+ result (count-words (point-min) (point))))))) + +(defun my-nov-skim-forward () + "Forward by 3-10% of the book." + (interactive) + (let ((pc (+ 3 (random 8)))) + (my-nov-goto-nth-word + (+ (my-nov-word-position) + (/ (* my-nov-total-word-count pc) 100))) + (message "Skimmed forward by %d%% of the book" pc))) + +(defun my-nov-skim-backward () + "Backward by 3-10% of the book." + (interactive) + (let ((pc (+ 3 (random 8)))) + (my-nov-goto-nth-word + (max + 0 + (- (my-nov-word-position) + (/ (* my-nov-total-word-count pc) 100)))) + (message "Skimmed backward by %d%% of the book" pc))) + +(defun my-nov-goto-random-position () + "Goto a random position in the epub." + (interactive) + (my-nov-count-words) + (let ((n (random my-nov-total-word-count))) + (my-nov-goto-nth-word n) + (message "Went to the %dth word (%d%% of the book)." + n (/ (* n 100) my-nov-total-word-count)))) + (provide 'my-nov) ;;; my-nov.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-org-jira.el b/emacs/.emacs.d/lisp/my/my-org-jira.el index 7ff7738..9e2f821 100644 --- a/emacs/.emacs.d/lisp/my/my-org-jira.el +++ b/emacs/.emacs.d/lisp/my/my-org-jira.el @@ -28,97 +28,186 @@ (require 'org-jira) +;;; override `org-jira-sdk-issue' +(defclass org-jira-sdk-issue (org-jira-sdk-record) + ((affected-versions :type string :initarg :affected-versions) + (assignee :type (or null string) :initarg :assignee) + (components :type string :initarg :components) + (fix-versions :type string :initarg :fix-versions) + (labels :type string :initarg :labels) + (created :type string :initarg :created) + (description :type (or null string) :initarg :description) + (duedate :type (or null string) :initarg :duedate) + (headline :type string :initarg :headline) + (id :type string :initarg :id) ; TODO: Probably remove me + (issue-id :type string :initarg :issue-id :documentation "The common ID/key, such as EX-1.") + (issue-id-int :type string :initarg :issue-id-int :documentation "The internal Jira ID, such as 12345.") + (filename :type (or null string) :initarg :filename :documentation "The filename to write issue to.") + (priority :type (or null string) :initarg :priority) + (proj-key :type string :initarg :proj-key) + (related-issues :type string :initarg :related-issues) + (reporter :type (or null string) :initarg :reporter) + (resolution :type (or null string) :initarg :resolution) + (sprint :type (or null string) :initarg :sprint) + (start-date :type (or null string) :initarg :start-date) + (status :type string :initarg :status) + (summary :type string :initarg :summary) + (type :type string :initarg :type) + (type-id :type string :initarg :type-id) + (updated :type string :initarg :updated) + (data :initarg :data :documentation "The remote Jira data object (alist).") + (hydrate-fn :initform #'jiralib-get-issue :initarg :hydrate-fn)) + "An issue on the end. ID of the form EX-1, or a numeric such as 10000.") + + +;;; override `org-jira-sdk-from-data' +(cl-defmethod org-jira-sdk-from-data ((rec org-jira-sdk-issue)) + ;; (print rec) + (cl-flet ((path (keys) (org-jira-sdk-path (oref rec data) keys))) + (org-jira-sdk-issue + :affected-versions (mapconcat (lambda (c) (org-jira-sdk-path c '(name))) (path '(fields versions)) ", ") + :assignee (path '(fields assignee displayName)) + :components (mapconcat (lambda (c) (org-jira-sdk-path c '(name))) (path '(fields components)) ", ") + :fix-versions (mapconcat (lambda (c) (org-jira-sdk-path c '(name))) (path '(fields fixVersions)) ", ") + :labels (mapconcat (lambda (c) (format "%s" c)) (mapcar #'identity (path '(fields labels))) ", ") + :created (path '(fields created)) ; confirm + :description (or (path '(fields description)) "") + :duedate (or (path '(fields sprint endDate)) (path '(fields duedate))) ; confirm + :filename (path '(fields project key)) + :headline (path '(fields summary)) ; Duplicate of summary, maybe different. + :id (path '(key)) + :issue-id (path '(key)) + :issue-id-int (path '(id)) + :priority (path '(fields priority name)) + :proj-key (path '(fields project key)) + :related-issues (mapconcat + (lambda (c) + ;; (print c) + (if (org-jira-sdk-path c '(inwardIssue)) + (if (equal + (org-jira-sdk-path + c '(inwardIssue fields status name)) + "Closed") + "" + (format "%s: %s %s" + (org-jira-sdk-path c '(type inward)) + (org-jira-sdk-path c '(inwardIssue key)) + (org-jira-sdk-path c '(inwardIssue fields summary)))) + (if (equal + (org-jira-sdk-path + c '(outwardIssue fields status name)) + "Closed") + "" + (format "%s: %s %s" + (org-jira-sdk-path c '(type outward)) + (org-jira-sdk-path c '(outwardIssue key)) + (org-jira-sdk-path c '(outwardIssue fields summary)))))) + (path '(fields issuelinks)) "; ") + :reporter (path '(fields reporter displayName)) ; reporter could be an object of its own slot values + :resolution (path '(fields resolution name)) ; confirm + :sprint (path '(fields sprint name)) + :start-date (path '(fields start-date)) ; confirm + :status (org-jira-decode (path '(fields status name))) + :summary (path '(fields summary)) + :type (path '(fields issuetype name)) + :type-id (path '(fields issuetype id)) + :updated (path '(fields updated)) ; confirm + ;; TODO: Remove this + ;; :data (oref rec data) + ))) + ;; Override `org-jira--render-issue' ;; include issue-id in the headline (defun my-org-jira--render-issue (Issue) "Render single ISSUE." ;; (org-jira-log "Rendering issue from issue list") ;; (org-jira-log (org-jira-sdk-dump Issue)) + ;; (print Issue) (with-slots (filename proj-key issue-id summary status priority headline id) Issue (let (p) (with-current-buffer (org-jira--get-project-buffer Issue) (org-jira-freeze-ui - (org-jira-maybe-activate-mode) - (org-jira--maybe-render-top-heading proj-key) - (setq p (org-find-entry-with-id issue-id)) - (save-restriction - (if (and p (>= p (point-min)) - (<= p (point-max))) - (progn - (goto-char p) - (forward-thing 'whitespace) - (org-jira-kill-line)) - (goto-char (point-max)) - (unless (looking-at "^") - (insert "\n")) - (insert "** ")) - (org-jira-insert - (concat (org-jira-get-org-keyword-from-status status) - " " - (org-jira-get-org-priority-cookie-from-issue priority) - issue-id " " headline)) - (save-excursion - (unless (search-forward "\n" (point-max) 1) - (insert "\n"))) - (org-narrow-to-subtree) - (save-excursion - (org-back-to-heading t) - (org-set-tags-to (replace-regexp-in-string "-" "_" issue-id))) - (mapc (lambda (entry) - (let ((val (slot-value Issue entry))) - (when (or (and val (not (string= val ""))) - (eq entry 'assignee)) ;; Always show assignee - (org-jira-entry-put (point) (symbol-name entry) val)))) - '(assignee filename reporter type type-id priority labels resolution status components created updated sprint)) - - (org-jira-entry-put (point) "ID" issue-id) - (org-jira-entry-put (point) "CUSTOM_ID" issue-id) - - ;; Insert the duedate as a deadline if it exists - (when org-jira-deadline-duedate-sync-p - (let ((duedate (oref Issue duedate))) - (when (> (length duedate) 0) - (org-deadline nil duedate)))) - - (mapc - (lambda (heading-entry) - (ensure-on-issue-id-with-filename issue-id filename - (let* ((entry-heading - (concat (symbol-name heading-entry) - (format ": [[%s][%s]]" - (concat jiralib-url "/browse/" issue-id) issue-id)))) - (setq p (org-find-exact-headline-in-buffer entry-heading)) - (if (and p (>= p (point-min)) - (<= p (point-max))) - (progn - (goto-char p) - (org-narrow-to-subtree) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - (if (org-goto-first-child) - (org-insert-heading) - (goto-char (point-max)) - (org-insert-subheading t)) - (org-jira-insert entry-heading "\n")) - - ;; Insert 2 spaces of indentation so Jira markup won't cause org-markup - (org-jira-insert - (replace-regexp-in-string - "^" " " - (format "%s" (slot-value Issue heading-entry))))))) - '(description)) - - (when org-jira-download-comments - (org-jira-update-comments-for-issue Issue) - - ;; FIXME: Re-enable when attachments are not erroring. - ;;(org-jira-update-attachments-for-current-issue) - ) - - ;; only sync worklog clocks when the user sets it to be so. - (when org-jira-worklog-sync-p - (org-jira-update-worklogs-for-issue issue-id filename)))))))) + (org-jira-maybe-activate-mode) + (org-jira--maybe-render-top-heading proj-key) + (setq p (org-find-entry-with-id issue-id)) + (save-restriction + (if (and p (>= p (point-min)) + (<= p (point-max))) + (progn + (goto-char p) + (forward-thing 'whitespace) + (org-jira-kill-line)) + (goto-char (point-max)) + (unless (looking-at "^") + (insert "\n")) + (insert "** ")) + (org-jira-insert + (concat (org-jira-get-org-keyword-from-status status) + " " + (org-jira-get-org-priority-cookie-from-issue priority) + issue-id " " headline)) + (save-excursion + (unless (search-forward "\n" (point-max) 1) + (insert "\n"))) + (org-narrow-to-subtree) + (save-excursion + (org-back-to-heading t) + (org-set-tags-to (replace-regexp-in-string "-" "_" issue-id))) + (mapc (lambda (entry) + (let ((val (slot-value Issue entry))) + (when (or (and val (not (string= val ""))) + (eq entry 'assignee)) ;; Always show assignee + (org-jira-entry-put (point) (symbol-name entry) val)))) + '(assignee filename reporter type type-id priority affected-versions fix-versions labels resolution status components created updated sprint related-issues)) + + (org-jira-entry-put (point) "ID" issue-id) + (org-jira-entry-put (point) "CUSTOM_ID" issue-id) + + ;; Insert the duedate as a deadline if it exists + (when org-jira-deadline-duedate-sync-p + (let ((duedate (oref Issue duedate))) + (when (> (length duedate) 0) + (org-deadline nil duedate)))) + + (mapc + (lambda (heading-entry) + (ensure-on-issue-id-with-filename issue-id filename + (let* ((entry-heading + (concat (symbol-name heading-entry) + (format ": [[%s][%s]]" + (concat jiralib-url "/browse/" issue-id) issue-id)))) + (setq p (org-find-exact-headline-in-buffer entry-heading)) + (if (and p (>= p (point-min)) + (<= p (point-max))) + (progn + (goto-char p) + (org-narrow-to-subtree) + (goto-char (point-min)) + (forward-line 1) + (delete-region (point) (point-max))) + (if (org-goto-first-child) + (org-insert-heading) + (goto-char (point-max)) + (org-insert-subheading t)) + (org-jira-insert entry-heading "\n")) + + ;; Insert 2 spaces of indentation so Jira markup won't cause org-markup + (org-jira-insert + (replace-regexp-in-string + "^" " " + (format "%s" (slot-value Issue heading-entry))))))) + '(description)) + + (when org-jira-download-comments + (org-jira-update-comments-for-issue Issue) + + ;; FIXME: Re-enable when attachments are not erroring. + ;;(org-jira-update-attachments-for-current-issue) + ) + + ;; only sync worklog clocks when the user sets it to be so. + (when org-jira-worklog-sync-p + (org-jira-update-worklogs-for-issue issue-id filename)))))))) ;; Overload `org-jira-update-worklogs-from-org-clocks'. (defun my-org-jira-update-worklogs-from-org-clocks () @@ -180,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..4582f6c --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-org-remark.el @@ -0,0 +1,101 @@ +;;; 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: + + +;;; 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 + (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 4fea460..e628c5b 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: " @@ -1176,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: ") @@ -1364,6 +1369,12 @@ With a prefix arg, yank and exit immediately." (yank)) (org-edit-src-exit)))) +;; used to add an :after advice to `org-edit-special'. +(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)) + (defun my-link-to-line-number-in-prog-mode () "When in prog-mode, use line number as search item." (when (derived-mode-p 'prog-mode) @@ -1651,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-package.el b/emacs/.emacs.d/lisp/my/my-package.el index b591d0f..ab3ad77 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 corfu icomplete isearch paredit my-utils my-buffer my-editing my-complete) "Common packages to include with any profile") diff --git a/emacs/.emacs.d/lisp/my/my-pdf-tools.el b/emacs/.emacs.d/lisp/my/my-pdf-tools.el index 8fe884c..0d498eb 100644 --- a/emacs/.emacs.d/lisp/my/my-pdf-tools.el +++ b/emacs/.emacs.d/lisp/my/my-pdf-tools.el @@ -196,5 +196,20 @@ (defun my-pdf-view-enlarge-a-bit () (interactive) (pdf-view-enlarge 1.01)) (defun my-pdf-view-shrink-a-bit () (interactive) (pdf-view-enlarge .99)) +(defvar my-pdf-dptrp1-ip nil + "IP address of digital paper device for dpt-rp1 to connect to.") + +(defvar my-pdf-dptrp1-program "dptrp1" "The name of the dpt-rp1 program.") + +(defun my-pdf-dptrp1-upload (dest) + (interactive (list (read-string "[dptrp1] Upload to: " "Document/"))) + (let ((file (buffer-file-name))) + (with-temp-buffer + (if (= (call-process my-pdf-dptrp1-program nil (current-buffer) nil + "--addr" my-pdf-dptrp1-ip "upload" file dest) + 0) + (message "Uploaded %s to %s" file dest) + (message "Failed to upload %s to %s: %s" file dest (buffer-string)))))) + (provide 'my-pdf-tools) ;;; my-pdf-tools.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-prog.el b/emacs/.emacs.d/lisp/my/my-prog.el index 9d6a778..92fcf21 100644 --- a/emacs/.emacs.d/lisp/my/my-prog.el +++ b/emacs/.emacs.d/lisp/my/my-prog.el @@ -54,6 +54,13 @@ (sleep-for .1) (my-comint-revive)) +(defun my-comint-add-write-history-hook () + "Add `comint-write-input-ring' to `kill-buffer-hook'. + +To use as a hook to comint mode, so that history is updated on +buffer kill." + (add-hook 'kill-buffer-hook 'comint-write-input-ring 0 t)) + (defvar my-comint-revive-commands '((shell-mode . my-shell-revive) (inferior-emacs-lisp-mode . ielm)) @@ -329,12 +336,9 @@ left and the source buffer on the right. (defun my-gdb-quit () (interactive) - (let ((old-window (selected-window))) - (select-window (get-buffer-window gud-comint-buffer)) - (goto-char (point-max)) - (gdb-delchar-or-quit 0) - (my-toggle-lock-current-window-to-buffer) - (when (window-live-p old-window) (select-window old-window)))) + (let ((kill-buffer-query-functions nil)) + (kill-buffer gud-comint-buffer)) + ) (defun my-gdb-frames-add-breakpoint () (interactive) @@ -361,7 +365,100 @@ 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. +(defun my-gdb-frame-handler () + "Set `gdb-selected-frame' and `gdb-selected-file' to show +overlay arrow in source buffer." + (let ((frame (gdb-mi--field (gdb-mi--partial-output) 'frame))) + (when frame + (setq gdb-selected-frame (gdb-mi--field frame 'func)) + (setq gdb-selected-file + (when-let ((full (gdb-mi--field frame 'fullname))) + (file-local-name full))) + (setq gdb-frame-number (gdb-mi--field frame 'level)) + (setq gdb-frame-address (gdb-mi--field frame 'addr)) + (let ((line (gdb-mi--field frame 'line))) + (setq gdb-selected-line (and line (string-to-number line))) + (when (and gdb-selected-file gdb-selected-line + (not (and (boundp 'gud-gdb-fetch-lines-break) + gud-gdb-fetch-lines-break))) + (setq gud-last-frame (cons gdb-selected-file gdb-selected-line)) + (gud-display-frame))) + (if gud-overlay-arrow-position + (let ((buffer (marker-buffer gud-overlay-arrow-position)) + (position (marker-position gud-overlay-arrow-position))) + (when buffer + (with-current-buffer buffer + (setq fringe-indicator-alist + (if (string-equal gdb-frame-number "0") + nil + '((overlay-arrow . hollow-right-triangle)))) + (setq gud-overlay-arrow-position (make-marker)) + (set-marker gud-overlay-arrow-position position)))))))) + + +;;; Can't override gud-gdbmi-completions - would get: +;;; error in process filter: gud-marker-filter: Symbol’s value as variable is void: gud-gdb-fetch-lines-string +;;; error in process filter: Symbol’s value as variable is void: gud-gdb-fetch-lines-string + +;; (defun gud-gdbmi-completions (context command) +;; "Completion table for GDB/MI commands. +;; COMMAND is the prefix for which we seek completion. +;; CONTEXT is the text before COMMAND on the line." +;; (let ((gud-gdb-fetch-lines-in-progress t) +;; (gud-gdb-fetch-lines-string nil) +;; (gud-gdb-fetch-lines-break (length context)) +;; (gud-gdb-fetched-lines nil) +;; ;; This filter dumps output lines to `gud-gdb-fetched-lines'. +;; (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)) +;; (with-current-buffer (gdb-get-buffer 'gdb-partial-output-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))) +;; (gud-gdb-completions-1 gud-gdb-fetched-lines))) + +(defun my-gud-watch-expr (expr) + (with-current-buffer gud-comint-buffer + (insert "watch -l " expr) + (comint-send-input))) + +(defun my-gud-print-expr (expr) + (with-current-buffer gud-comint-buffer + (insert "p " expr) + (comint-send-input))) + +(defun my-gud-print-expr-region (b e) + (interactive "r") + (unless (eq (gdb-get-source-buffer) (current-buffer)) + (error "Not in the source buffer")) + (if current-prefix-arg + (my-gud-watch-expr (buffer-substring b e)) + (my-gud-print-expr (buffer-substring b e)))) ;;; which-func (defun my-copy-which-func () @@ -394,8 +491,8 @@ left and the source buffer on the right. record)) ;;; bison-mode -(require 'bison-mode) (defun my-bison-imenu-create-index () + (require 'bison-mode) (let ((end)) (beginning-of-buffer) (re-search-forward "^%%") @@ -409,8 +506,8 @@ left and the source buffer on the right. 'my-bison-imenu-create-index)) ;;; json-mode -(require 'json-mode) (defun my-json-mode-path () + (require 'json-mode) (string-join (mapcar 'prin1-to-string (plist-get (json-path-to-position (point)) :path)) "/")) @@ -430,6 +527,34 @@ left and the source buffer on the right. (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'" @@ -457,6 +582,7 @@ left and the source buffer on the right. (auto-fill-mode) (display-line-numbers-mode) (setq tab-width 2) + (setq indent-tabs-mode nil) (bug-reference-prog-mode) (flyspell-prog-mode)) diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el index c64c9ac..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 @@ -321,7 +328,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")) + "wav" "wma" "spc" "mp4")) (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv")))) ;;; files @@ -332,6 +339,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..7c9c567 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,122 @@ (kill-new url) (message "Copied link: %s" url))) +;;; webgetter +(require 'my-net) +(defun my-fetch-browse (url &optional no-overwrite) + "Fetch URL to a local file then browse it with firefox. + +Useful for bypassing \"Enable JavaScript and cookies to continue\"." + (interactive "sUrl to fetch and browse: ") + (let ((file-name + (if no-overwrite + (my-make-unique-file-name + (my-make-file-name-from-url url) + my-webpage-download-dir) + (expand-file-name + (my-make-file-name-from-url url "html") + my-webpage-download-dir)))) + (url-copy-file url file-name (not no-overwrite)) + (browse-url-firefox (format "file://%s" file-name)))) + +(defun my-fetch-browse-as-googlebot (url &optional no-overwrite) + "Same as `my-fetch-browse', but spoofing googlebot. + +Useful for bypassing some paywalls." + (interactive "sUrl to fetch and browse as googlebot: ") + (my-url-as-googlebot + (my-fetch-browse url no-overwrite))) + +(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. +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)) + +(defvar my-firefox-profile-dir nil "Firefox profile dir") +(defvar my-firefox-place-limit 1000 "Firefox urls result limit") + +(defun my-firefox-places (&optional query) + (let ((where + (mapconcat + (lambda (word) (format "(url LIKE '%%%s%%' OR title LIKE '%%%s%%')" word word)) + (split-string (or query "")) + " AND "))) + (unless (string-empty-p where) (setq where (format "WHERE %s" where))) + (with-temp-buffer + (call-process "sqlite3" nil t nil + (format "file://%s/places.sqlite?immutable=1" + (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)) + (string-lines (buffer-string)) + ))) + +(defun my-firefox-places-collection (query pred action) + (if (eq action 'metadata) + `(metadata (display-sort-function . ,#'identity) + ;; Needed for icomplete to respect list order + (cycle-sort-function . ,#'identity)) + (let ((candidates (my-firefox-places query))) + (message "Got %d candidates for query %s. Current action is %s" (length candidates) query action) + (cl-loop for str in-ref candidates do + (setf str (orderless--highlight regexps ignore-case (substring str)))) + candidates + ;; Does not show remotely as many results + ;; (complete-with-action action candidates query pred) + ))) + +(defun my-browse-url (url) + (interactive (list (completing-read "URL to browse: " + #'my-firefox-places-collection))) + (message url)) + +(defun my-forge-infobox-format-url (url) + (concat url + " -- " (buttonize "clone" + (lambda (_) + (my-magit-clone url current-prefix-arg))) + " " (buttonize "context" + (lambda (_) + (funcall my-url-context-function url))))) + (provide 'my-web) ;;; my-web.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-wget.el b/emacs/.emacs.d/lisp/my/my-wget.el index 5349257..e7283aa 100644 --- a/emacs/.emacs.d/lisp/my/my-wget.el +++ b/emacs/.emacs.d/lisp/my/my-wget.el @@ -48,20 +48,31 @@ (kill-new full-path) (message "Saved webpage to %s (path copied)." full-path))) -(defun my-wget-async (url filename &optional no-tor move-if-video-or-large) +(defun my-wget-async (url filename &optional no-tor on-success on-fail) (set-process-sentinel (my-start-process-with-torsocks no-tor "wget" "*wget*" "wget" url "-c" "-O" filename) - (lambda (_process _event) - (when (and move-if-video-or-large - (or - (> (file-attribute-size (file-attributes filename)) - my-wget-size-threshold) - (member (file-name-extension filename) my-wget-video-extensions))) - (setq filename - (my-rename-and-symlink-back - filename (expand-file-name my-wget-video-archive-directory) nil))) - (message "Fetched %s and saved to: %s" url filename)))) + (lambda (proc event) + (let ((ps (process-status proc)) + (status (process-exit-status proc))) + (if (eq status 0) + (progn + (message "[DONE] Fetched %s to %s" url filename) + (when on-success (funcall on-success))) + (message "[FAIL] Fetching %s to %s: %s" url filename event) + (when on-fail (funcall on-fail)))) + ) + )) + +(defun my-wget-move-if-video-or-large (url filename _process _event) + (when (or + (> (file-attribute-size (file-attributes filename)) + my-wget-size-threshold) + (member (file-name-extension filename) my-wget-video-extensions)) + (setq filename + (my-rename-and-symlink-back + filename (expand-file-name my-wget-video-archive-directory) nil))) + (message "Fetched %s and saved to: %s" url filename)) (defun wget-async-urls-with-prefix (urls prefix &optional no-tor move-if-video-or-large) (let ((i 1)) diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el index 721b299..b3b1cf7 100644 --- a/emacs/.emacs.d/lisp/my/my-ytdl.el +++ b/emacs/.emacs.d/lisp/my/my-ytdl.el @@ -76,6 +76,67 @@ (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\\|yewtu\\.be\\)" + (url-host urlobj)) + (string-match-p "^/watch\\?v=.*" (url-filename urlobj))) + (equal "youtu.be" (url-host urlobj))))) + +(require 'hmm) +(defvar my-ytdl-player 'hmm-external-mpv "Function to play ytdl urls.") + +(defun my-ytdl-video-format-seconds (secs) + (setq secs (floor secs)) + (if (>= secs 3600) + (format "%d:%02d:%02d" + (/ secs 3600) (/ (% secs 3600) 60) (% secs 60)) + (format "%d:%02d" + (/ secs 60) (% secs 60)))) + +(defun my-ytdl-video-format-chapters (chapters) + (mapconcat + (lambda (chapter) + (let-alist chapter + (format "%s: %s-%s" .title (my-ytdl-video-format-seconds .start_time) + (my-ytdl-video-format-seconds .end_time)))) + chapters + "; ")) + +(defun my-ytdl-video-render-info (info url) + (setf (alist-get 'webpage_url info) + (concat (alist-get 'webpage_url info) + " -- " (buttonize "play" (lambda (_) + (funcall my-ytdl-player url))) + " " (buttonize "context" + (lambda (_) + (funcall my-url-context-function url)))) + (alist-get 'chapters info) + (my-ytdl-video-format-chapters (alist-get 'chapters info))) + (infobox-render + (infobox-translate info (infobox-default-specs info)) + `(my-ytdl-video-infobox ,url) + (called-interactively-p 'interactive))) + +(defun my-ytdl-video-infobox (url) + (interactive "sytdl video url: ") + ;; Remove any extra queries from the URL + (setq url (replace-regexp-in-string "&.*" "" url)) + (my-ytdl-video-render-info (my-ytdl-video-info url) url)) + ;;; fixme: autoload (defun my-ytdl-video (urls) "Download videos with ytdl." @@ -87,6 +148,11 @@ (interactive "sURL(s): ") (my-ytdl-internal urls 'audio)) +(defun my-ytdl-audio-no-tor (urls) + "Download audio with ytdl." + (interactive "sURL(s): ") + (my-ytdl-internal urls 'audio t)) + ;;; fixme: autoload (defun my-ytdl-video-no-tor (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..f8bc77f --- /dev/null +++ b/emacs/.emacs.d/lisp/my/reddio.el @@ -0,0 +1,80 @@ +;;; 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*") + +(defvar reddio-dir (locate-user-emacs-file "reddio") + "Path to local directory of saved threads.") + +(defun reddio-make-filename (url) + (string-match "/r/\\([^/]+\\)/comments/\\([^/]+\\)/\\([^/]+\\)" url) + (file-name-concat + reddio-dir + (format "%s.%s.%s.txt" + (match-string 1 url) + (match-string 3 url) + (match-string 2 url)))) + +(defun reddio-save-text-and-switch-to-buffer (text file-name) + "Save TEXT to FILE-NAME and switch to buffer." + (let ((buffer (find-file-noselect file-name)) + (coding-system-for-write 'utf-8)) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert text)) + (goto-char (point-min)) + (save-buffer) + (revert-buffer t t)) + (switch-to-buffer buffer))) + +(defun reddio-open-url (url) + (interactive "sReddit link: ") + (let ((text + (when (string-match "/\\(comments/[^/]+\\)/" url) + (with-temp-buffer + (if (= 0 (call-process "reddio" nil (current-buffer) nil + "print" "-l" "500" + (match-string 1 url))) + (goto-char (point-min)) + (error "reddio process failed: %s" (buffer-string))) + (delete-trailing-whitespace) + (buffer-string))))) + (reddio-save-text-and-switch-to-buffer + text + (reddio-make-filename url)))) + +(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 diff --git a/emacs/.emacs.d/tempel-templates b/emacs/.emacs.d/tempel-templates index 2b421cc..ab35739 100644 --- a/emacs/.emacs.d/tempel-templates +++ b/emacs/.emacs.d/tempel-templates @@ -217,6 +217,13 @@ org-mode (inlsrc "src_" p "{" q "}") (title "#+title: " p n "#+author: " (user-full-name) n "#+language: en") +c++-mode + +(ifdef "#ifdef " (p "" sym) " +" + r + " +#endif /* " sym " */" ) ;; Local Variables: ;; mode: lisp-data diff --git a/manual/singlefile-settings.json b/manual/singlefile-settings.json new file mode 100644 index 0000000..3cdd2a8 --- /dev/null +++ b/manual/singlefile-settings.json @@ -0,0 +1,185 @@ +{ + "profiles": { + "__Default_Settings__": { + "removeHiddenElements": true, + "removeUnusedStyles": true, + "removeUnusedFonts": true, + "removeFrames": true, + "blockScripts": true, + "blockVideos": true, + "blockAudios": true, + "blockFonts": false, + "blockStylesheets": false, + "blockImages": false, + "acceptHeaders": { + "document": "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8", + "script": "*/*", + "audio": "audio/webm,audio/ogg,audio/wav,audio/*;q=0.9,application/ogg;q=0.7,video/*;q=0.6,*/*;q=0.5", + "video": "video/webm,video/ogg,video/*;q=0.9,application/ogg;q=0.7,audio/*;q=0.6,*/*;q=0.5", + "font": "application/font-woff2;q=1.0,application/font-woff;q=0.9,*/*;q=0.8", + "stylesheet": "text/css,*/*;q=0.1", + "image": "image/avif,image/webp,image/apng,image/svg+xml,image/*,*/*;q=0.8" + }, + "saveRawPage": false, + "insertMetaCSP": true, + "saveToClipboard": false, + "addProof": false, + "woleetKey": "", + "saveToGDrive": false, + "saveToDropbox": false, + "saveWithWebDAV": false, + "webDAVURL": "", + "webDAVUser": "", + "webDAVPassword": "", + "saveToGitHub": false, + "githubToken": "", + "githubUser": "", + "githubRepository": "SingleFile-Archives", + "githubBranch": "main", + "saveWithCompanion": false, + "sharePage": false, + "compressHTML": true, + "insertTextBody": false, + "insertEmbeddedImage": false, + "insertEmbeddedScreenshotImage": false, + "compressCSS": false, + "groupDuplicateStylesheets": false, + "moveStylesInHead": false, + "loadDeferredImages": true, + "loadDeferredImagesMaxIdleTime": 1500, + "loadDeferredImagesKeepZoomLevel": false, + "loadDeferredImagesDispatchScrollEvent": false, + "loadDeferredImagesBeforeFrames": false, + "contextMenuEnabled": true, + "filenameTemplate": "%if-empty<{page-title}|No title>.{filename-extension}", + "filenameMaxLength": "192", + "filenameMaxLengthUnit": "bytes", + "filenameReplacementCharacter": "_", + "replaceEmojisInFilename": false, + "saveFilenameTemplateData": false, + "shadowEnabled": true, + "maxResourceSizeEnabled": true, + "maxResourceSize": 10, + "networkTimeout": 0, + "confirmFilename": false, + "filenameConflictAction": "overwrite", + "displayInfobar": true, + "displayStats": false, + "backgroundSave": true, + "autoSaveDelay": 1, + "autoSaveLoad": false, + "autoSaveUnload": false, + "autoSaveDiscard": false, + "autoSaveRemove": false, + "autoSaveLoadOrUnload": true, + "autoSaveRepeat": false, + "autoSaveRepeatDelay": 10, + "autoSaveExternalSave": false, + "removeAlternativeFonts": true, + "removeAlternativeImages": true, + "removeAlternativeMedias": true, + "saveCreatedBookmarks": false, + "passReferrerOnError": false, + "replaceBookmarkURL": true, + "allowedBookmarkFolders": [ + "" + ], + "ignoredBookmarkFolders": [ + "" + ], + "compressContent": false, + "createRootDirectory": false, + "preventAppendedData": false, + "selfExtractingArchive": false, + "extractDataFromPage": false, + "password": "", + "groupDuplicateImages": true, + "infobarTemplate": "", + "blockMixedContent": true, + "saveOriginalURLs": false, + "includeInfobar": false, + "openInfobar": false, + "removeSavedDate": false, + "confirmInfobarContent": false, + "autoClose": false, + "openEditor": false, + "openSavedPage": false, + "autoOpenEditor": false, + "defaultEditorMode": "normal", + "applySystemTheme": true, + "warnUnsavedPage": true, + "displayInfobarInEditor": false, + "saveToRestFormApi": false, + "saveToRestFormApiUrl": "", + "saveToRestFormApiToken": "", + "saveToRestFormApiFileFieldName": "", + "saveToRestFormApiUrlFieldName": "", + "saveToS3": false, + "S3Domain": "s3.amazonaws.com", + "S3Region": "", + "S3Bucket": "", + "S3AccessKey": "", + "S3SecretKey": "", + "loadDeferredImagesBlockCookies": false, + "loadDeferredImagesBlockStorage": false, + "filenameReplacedCharacters": [ + "~", + "+", + "?", + "%", + "*", + ":", + "|", + "\"", + "<", + ">", + "\\\\", + "\u0000-\u001f", + "" + ], + "filenameReplacementCharacters": [ + "_", + "_", + "_", + "_", + "_", + "_", + "_", + "_", + "_", + "_", + "_" + ], + "tabMenuEnabled": true, + "browserActionMenuEnabled": true, + "logsEnabled": true, + "progressBarEnabled": true, + "maxSizeDuplicateImages": 524288, + "forceWebAuthFlow": false, + "resolveFragmentIdentifierURLs": false, + "userScriptEnabled": false, + "saveFavicon": true, + "includeBOM": false, + "insertMetaNoIndex": false, + "insertSingleFileComment": true, + "blockAlternativeImages": true, + "delayBeforeProcessing": 0, + "_migratedTemplateFormat": true, + "resolveLinks": true, + "infobarPositionAbsolute": false, + "infobarPositionTop": "16px", + "infobarPositionRight": "16px", + "infobarPositionBottom": "", + "infobarPositionLeft": "" + } + }, + "rules": [ + { + "url": "file:", + "profile": "__Default_Settings__", + "autoSaveProfile": "__Disabled_Settings__" + } + ], + "maxParallelWorkers": 12, + "processInForeground": false +}
\ No newline at end of file diff --git a/mariadb-server/.dir-locals.el b/mariadb-server/.dir-locals.el index 595eb5b..2b4cff5 100644 --- a/mariadb-server/.dir-locals.el +++ b/mariadb-server/.dir-locals.el @@ -1,3 +1,35 @@ ((nil . ((bug-reference-bug-regexp . "\\<\\(\\)\\([Mm][Dd][Ee][Vv]-[0-9]+\\)\\>") (bug-reference-url-format . "https://jira.mariadb.org/browse/%s"))) - ) + (c++-mode + . ((indent-tabs-mode . nil) + (c-file-style . "linux") + (c-basic-offset . 2) + (c-offsets-alist + . ( + (inline-open . 0) + (substatement . +) + (statement-block-intro . +) + (arglist-cont-nonempty c-lineup-gcc-asm-reg c-lineup-arglist) + (inclass . +) + (defun-block-intro . +) + )) + (comment-start . "/* ") + (comment-end . " */") + (comment-continue . " ") + (comment-style . extra-line))) + (c-mode + . ((indent-tabs-mode . nil) + (c-file-style . "linux") + (c-basic-offset . 2) + (c-offsets-alist + . ( + (inline-open . 0) + (substatement . +) + (statement-block-intro . +) + (arglist-cont-nonempty c-lineup-gcc-asm-reg c-lineup-arglist) + (inclass . +) + )) + (comment-start . "/* ") + (comment-end . " */") + (comment-continue . " ") + (comment-style . extra-line)))) diff --git a/mariadb-server/sql/.dir-locals.el b/mariadb-server/sql/.dir-locals.el deleted file mode 100644 index 4093b3a..0000000 --- a/mariadb-server/sql/.dir-locals.el +++ /dev/null @@ -1,24 +0,0 @@ -((c++-mode - . ((indent-tabs-mode . nil) - (c-file-style . "linux") - (c-basic-offset . 2) - (c-offsets-alist - . ( - (inline-open . 0) - )) - (comment-start . "/* ") - (comment-end . " */") - (comment-continue . " ") - (comment-style . extra-line))) - (c-mode - . ((indent-tabs-mode . nil) - (c-file-style . "linux") - (c-basic-offset . 2) - (c-offsets-alist - . ( - (inline-open . 0) - )) - (comment-start . "/* ") - (comment-end . " */") - (comment-continue . " ") - (comment-style . extra-line)))) diff --git a/misc-root/etc/acpi/events/lid b/misc-root/etc/acpi/events/lid index 6479acc..5879194 100644 --- a/misc-root/etc/acpi/events/lid +++ b/misc-root/etc/acpi/events/lid @@ -1,2 +1,2 @@ event=button/lid.* -action=/etc/acpi/actions/lid.sh %e
\ No newline at end of file +action=/etc/acpi/actions/lid.sh %e diff --git a/misc-root/etc/tlp.conf b/misc-root/etc/tlp.conf new file mode 100644 index 0000000..e94042e --- /dev/null +++ b/misc-root/etc/tlp.conf @@ -0,0 +1,585 @@ +# ------------------------------------------------------------------------------ +# /etc/tlp.conf - TLP user configuration (version 1.6.1) +# See full explanation: https://linrunner.de/tlp/settings +# +# Copyright (c) 2023 Thomas Koch <linrunner at gmx.net> and others. +# SPDX-License-Identifier: GPL-2.0-or-later +# +# Settings are read in the following order: +# +# 1. Intrinsic defaults +# 2. /etc/tlp.d/*.conf - Drop-in customization snippets +# 3. /etc/tlp.conf - User configuration (this file) +# +# Notes: +# - In case of identical parameters, the last occurence has precedence +# - This also means, parameters enabled here will override anything else +# - However you may append values to a parameter already defined as intrinsic +# default or in a previously read file: use PARAMETER+="add values" +# - IMPORTANT: all parameters here are disabled; remove the leading '#' if you +# like to enable a feature without default or have a value different from the +# default +# - Default *: intrinsic default that is effective when the parameter is missing +# or disabled by a leading '#'; use PARAM="" to disable an intrinsic default +# - Default <none>: do nothing or use kernel/hardware defaults +# - IMPORTANT: parameters must always be specified pairwise i.e. for +# both AC and BAT. Omitting one of the two makes the set value effective for +# both power sources, since a change only occurs when different values are +# defined. +# ------------------------------------------------------------------------------ +# tlp - Parameters for power saving + +# Set to 0 to disable, 1 to enable TLP. +# Default: 1 + +#TLP_ENABLE=1 + +# Control how warnings about invalid settings are issued: +# 0=disabled, +# 1=background tasks (boot, resume, change of power source) report to syslog, +# 2=shell commands report to the terminal (stderr), +# 3=combination of 1 and 2 +# Default: 3 + +#TLP_WARN_LEVEL=3 + +# Operation mode when no power supply can be detected: AC, BAT. +# Concerns some desktop and embedded hardware only. +# Default: <none> + +#TLP_DEFAULT_MODE=AC + +# Operation mode select: 0=depend on power source, 1=always use TLP_DEFAULT_MODE +# Note: use in conjunction with TLP_DEFAULT_MODE=BAT for BAT settings on AC. +# Default: 0 + +#TLP_PERSISTENT_DEFAULT=0 + +# Power supply classes to ignore when determining operation mode: AC, USB, BAT. +# Separate multiple classes with spaces. +# Note: try on laptops where operation mode AC/BAT is incorrectly detected. +# Default: <none> + +#TLP_PS_IGNORE="BAT" + +# Seconds laptop mode has to wait after the disk goes idle before doing a sync. +# Non-zero value enables, zero disables laptop mode. +# Default: 0 (AC), 2 (BAT) + +#DISK_IDLE_SECS_ON_AC=0 +#DISK_IDLE_SECS_ON_BAT=2 + +# Dirty page values (timeouts in secs). +# Default: 15 (AC), 60 (BAT) + +#MAX_LOST_WORK_SECS_ON_AC=15 +#MAX_LOST_WORK_SECS_ON_BAT=60 + +# Select a CPU scaling driver operation mode. +# Intel CPU with intel_pstate driver: +# active, passive. +# AMD Zen 2 or newer CPU with amd-pstate_driver as of kernel 6.3/6.4(*): +# active, passive, guided(*). +# Default: <none> +#CPU_DRIVER_OPMODE_ON_AC=active +#CPU_DRIVER_OPMODE_ON_BAT=active + +# Select a CPU frequency scaling governor. +# Intel CPU with intel_pstate driver or +# AMD CPU with amd-pstate driver in active mode ('amd-pstate-epp'): +# performance, powersave(*). +# Intel CPU with intel_pstate driver in passive mode ('intel_cpufreq') or +# AMD CPU with amd-pstate driver in passive or guided mode ('amd-pstate') or +# Intel, AMD and other CPU brands with acpi-cpufreq driver: +# conservative, ondemand(*), userspace, powersave, performance, schedutil(*). +# Use tlp-stat -p to show the active driver and available governors. +# Important: +# Governors marked (*) above are power efficient for *almost all* workloads +# and therefore kernel and most distributions have chosen them as defaults. +# You should have done your research about advantages/disadvantages *before* +# changing the governor. +# Default: <none> + +#CPU_SCALING_GOVERNOR_ON_AC=powersave +#CPU_SCALING_GOVERNOR_ON_BAT=powersave + +# Set the min/max frequency available for the scaling governor. +# Possible values depend on your CPU. For available frequencies see +# the output of tlp-stat -p. +# Notes: +# - Min/max frequencies must always be specified for both AC *and* BAT +# - Not recommended for use with the intel_pstate driver, use +# CPU_MIN/MAX_PERF_ON_AC/BAT below instead +# Default: <none> + +#CPU_SCALING_MIN_FREQ_ON_AC=0 +#CPU_SCALING_MAX_FREQ_ON_AC=0 +#CPU_SCALING_MIN_FREQ_ON_BAT=0 +#CPU_SCALING_MAX_FREQ_ON_BAT=0 + +# Set CPU energy/performance policies EPP and EPB: +# performance, balance_performance, default, balance_power, power. +# Values are given in order of increasing power saving. +# Requires: +# * Intel CPU +# EPP: Intel Core i 6th gen. or newer CPU with intel_pstate driver +# EPB: Intel Core i 2nd gen. or newer CPU with intel_pstate driver +# as of kernel 5.2; alternatively module msr and +# x86_energy_perf_policy from linux-tools +# EPP and EPB are mutually exclusive: when EPP is available, Intel CPUs +# will not honor EPB. Only the matching feature will be applied by TLP. +# * AMD Zen 2 or newer CPU +# EPP: amd-pstate driver in active mode ('amd-pstate-epp') as of kernel 6.3 +# Default: balance_performance (AC), balance_power (BAT) + +#CPU_ENERGY_PERF_POLICY_ON_AC=balance_performance +#CPU_ENERGY_PERF_POLICY_ON_BAT=balance_power + +# Set Intel CPU P-state performance: 0..100 (%). +# Limit the max/min P-state to control the power dissipation of the CPU. +# Values are stated as a percentage of the available performance. +# Requires Intel Core i 2nd gen. or newer CPU with intel_pstate driver. +# Default: <none> + +#CPU_MIN_PERF_ON_AC=0 +#CPU_MAX_PERF_ON_AC=100 +#CPU_MIN_PERF_ON_BAT=0 +#CPU_MAX_PERF_ON_BAT=30 + +# Set the CPU "turbo boost" (Intel) or "turbo core" (AMD) feature: +# 0=disable, 1=allow. +# Allows to raise the maximum frequency/P-state of some cores if the +# CPU chip is not fully utilized and below it's intended thermal budget. +# Note: a value of 1 does *not* activate boosting, it just allows it. +# Default: <none> + +#CPU_BOOST_ON_AC=1 +#CPU_BOOST_ON_BAT=0 + +# Set Intel/AMD CPU dynamic boost feature: +# 0=disable, 1=enable. +# Improve performance by increasing minimum P-state limit dynamically +# whenever a task previously waiting on I/O is selected to run. +# Requires: +# * Intel Core i 6th gen. or newer CPU: intel_pstate driver in active mode +# * AMD Zen 2 or newer CPU: amd-pstate driver in active mode ('amd-pstate-epp') +# provided by a yet unreleased kernel 6.x +# Default: <none> + +#CPU_HWP_DYN_BOOST_ON_AC=1 +#CPU_HWP_DYN_BOOST_ON_BAT=0 + +# Kernel NMI Watchdog: +# 0=disable (default, saves power), 1=enable (for kernel debugging only). +# Default: 0 + +#NMI_WATCHDOG=0 + +# Select platform profile: +# performance, balanced, low-power. +# Controls system operating characteristics around power/performance levels, +# thermal and fan speed. Values are given in order of increasing power saving. +# Note: check the output of tlp-stat -p to determine availability on your +# hardware and additional profiles such as: balanced-performance, quiet, cool. +# Default: <none> + +#PLATFORM_PROFILE_ON_AC=performance +#PLATFORM_PROFILE_ON_BAT=low-power + +# System suspend mode: +# s2idle: Idle standby - a pure software, light-weight, system sleep state, +# deep: Suspend to RAM - the whole system is put into a low-power state, +# except for memory, usually resulting in higher savings than s2idle. +# CAUTION: changing suspend mode may lead to system instability and even +# data loss. As for the availability of different modes on your system, +# check the output of tlp-stat -s. If unsure, stick with the system default +# by not enabling this. +# Default: <none> + +#MEM_SLEEP_ON_AC=s2idle +#MEM_SLEEP_ON_BAT=deep + +# Define disk devices on which the following DISK/AHCI_RUNTIME parameters act. +# Separate multiple devices with spaces. +# Devices can be specified by disk ID also (lookup with: tlp diskid). +# Default: "nvme0n1 sda" + +#DISK_DEVICES="nvme0n1 sda" + +# Disk advanced power management level: 1..254, 255 (max saving, min, off). +# Levels 1..127 may spin down the disk; 255 allowable on most drives. +# Separate values for multiple disks with spaces. Use the special value 'keep' +# to keep the hardware default for the particular disk. +# Default: 254 (AC), 128 (BAT) + +#DISK_APM_LEVEL_ON_AC="254 254" +#DISK_APM_LEVEL_ON_BAT="128 128" + +# Exclude disk classes from advanced power management (APM): +# sata, ata, usb, ieee1394. +# Separate multiple classes with spaces. +# CAUTION: USB and IEEE1394 disks may fail to mount or data may get corrupted +# with APM enabled. Be careful and make sure you have backups of all affected +# media before removing 'usb' or 'ieee1394' from the denylist! +# Default: "usb ieee1394" + +#DISK_APM_CLASS_DENYLIST="usb ieee1394" + +# Hard disk spin down timeout: +# 0: spin down disabled +# 1..240: timeouts from 5s to 20min (in units of 5s) +# 241..251: timeouts from 30min to 5.5 hours (in units of 30min) +# See 'man hdparm' for details. +# Separate values for multiple disks with spaces. Use the special value 'keep' +# to keep the hardware default for the particular disk. +# Default: <none> + +#DISK_SPINDOWN_TIMEOUT_ON_AC="0 0" +#DISK_SPINDOWN_TIMEOUT_ON_BAT="0 0" + +# Select I/O scheduler for the disk devices. +# Multi queue (blk-mq) schedulers: +# mq-deadline(*), none, kyber, bfq +# Single queue schedulers: +# deadline(*), cfq, bfq, noop +# (*) recommended. +# Separate values for multiple disks with spaces. Use the special value 'keep' +# to keep the kernel default scheduler for the particular disk. +# Notes: +# - Multi queue (blk-mq) may need kernel boot option 'scsi_mod.use_blk_mq=1' +# and 'modprobe mq-deadline-iosched|kyber|bfq' on kernels < 5.0 +# - Single queue schedulers are legacy now and were removed together with +# the old block layer in kernel 5.0 +# Default: keep + +#DISK_IOSCHED="mq-deadline mq-deadline" + +# AHCI link power management (ALPM) for SATA disks: +# min_power, med_power_with_dipm(*), medium_power, max_performance. +# (*) recommended. +# Multiple values separated with spaces are tried sequentially until success. +# Default: med_power_with_dipm (AC & BAT) + +#SATA_LINKPWR_ON_AC="med_power_with_dipm" +#SATA_LINKPWR_ON_BAT="med_power_with_dipm" + +# Exclude SATA links from AHCI link power management (ALPM). +# SATA links are specified by their host. Refer to the output of +# tlp-stat -d to determine the host; the format is "hostX". +# Separate multiple hosts with spaces. +# Default: <none> + +#SATA_LINKPWR_DENYLIST="host1" + +# Runtime Power Management for NVMe, SATA, ATA and USB disks +# as well as SATA ports: +# on=disable, auto=enable. +# Note: SATA controllers are PCIe bus devices and handled by RUNTIME_PM further +# down. + +# Default: on (AC), auto (BAT) + +#AHCI_RUNTIME_PM_ON_AC=on +#AHCI_RUNTIME_PM_ON_BAT=auto + +# Seconds of inactivity before disk is suspended. +# Note: effective only when AHCI_RUNTIME_PM_ON_AC/BAT is activated. +# Default: 15 + +#AHCI_RUNTIME_PM_TIMEOUT=15 + +# Power off optical drive in UltraBay/MediaBay: 0=disable, 1=enable. +# Drive can be powered on again by releasing (and reinserting) the eject lever +# or by pressing the disc eject button on newer models. +# Note: an UltraBay/MediaBay hard disk is never powered off. +# Default: 0 + +#BAY_POWEROFF_ON_AC=0 +#BAY_POWEROFF_ON_BAT=0 + +# Optical drive device to power off +# Default: sr0 + +#BAY_DEVICE="sr0" + +# Set the min/max/turbo frequency for the Intel GPU. +# Possible values depend on your hardware. For available frequencies see +# the output of tlp-stat -g. +# Default: <none> + +#INTEL_GPU_MIN_FREQ_ON_AC=0 +#INTEL_GPU_MIN_FREQ_ON_BAT=0 +#INTEL_GPU_MAX_FREQ_ON_AC=0 +#INTEL_GPU_MAX_FREQ_ON_BAT=0 +#INTEL_GPU_BOOST_FREQ_ON_AC=0 +#INTEL_GPU_BOOST_FREQ_ON_BAT=0 + +# AMD GPU power management. +# Performance level (DPM): auto, low, high; auto is recommended. +# Note: requires amdgpu or radeon driver. +# Default: auto + +#RADEON_DPM_PERF_LEVEL_ON_AC=auto +#RADEON_DPM_PERF_LEVEL_ON_BAT=auto + +# Dynamic power management method (DPM): balanced, battery, performance. +# Note: radeon driver only. +# Default: <none> + +#RADEON_DPM_STATE_ON_AC=performance +#RADEON_DPM_STATE_ON_BAT=battery + +# Graphics clock speed (profile method): low, mid, high, auto, default; +# auto = mid on BAT, high on AC. +# Note: radeon driver on legacy ATI hardware only (where DPM is not available). +# Default: default + +#RADEON_POWER_PROFILE_ON_AC=default +#RADEON_POWER_PROFILE_ON_BAT=default + +# Wi-Fi power saving mode: on=enable, off=disable. +# Default: off (AC), on (BAT) + +#WIFI_PWR_ON_AC=off +#WIFI_PWR_ON_BAT=on + +# Disable Wake-on-LAN: Y/N. +# Default: Y + +#WOL_DISABLE=Y + +# Enable audio power saving for Intel HDA, AC97 devices (timeout in secs). +# A value of 0 disables, >= 1 enables power saving. +# Note: 1 is recommended for Linux desktop environments with PulseAudio, +# systems without PulseAudio may require 10. +# Default: 1 + +#SOUND_POWER_SAVE_ON_AC=1 +#SOUND_POWER_SAVE_ON_BAT=1 + +# Disable controller too (HDA only): Y/N. +# Note: effective only when SOUND_POWER_SAVE_ON_AC/BAT is activated. +# Default: Y + +#SOUND_POWER_SAVE_CONTROLLER=Y + +# PCIe Active State Power Management (ASPM): +# default(*), performance, powersave, powersupersave. +# (*) keeps BIOS ASPM defaults (recommended) +# Default: <none> + +#PCIE_ASPM_ON_AC=default +#PCIE_ASPM_ON_BAT=default + +# Runtime Power Management for PCIe bus devices: on=disable, auto=enable. +# Default: on (AC), auto (BAT) + +#RUNTIME_PM_ON_AC=on +#RUNTIME_PM_ON_BAT=auto + +# Exclude listed PCIe device adresses from Runtime PM. +# Note: this preserves the kernel driver default, to force a certain state +# use RUNTIME_PM_ENABLE/DISABLE instead. +# Separate multiple addresses with spaces. +# Use lspci to get the adresses (1st column). +# Default: <none> + +#RUNTIME_PM_DENYLIST="11:22.3 44:55.6" + +# Exclude PCIe devices assigned to the listed drivers from Runtime PM. +# Note: this preserves the kernel driver default, to force a certain state +# use RUNTIME_PM_ENABLE/DISABLE instead. +# Separate multiple drivers with spaces. +# Default: "mei_me nouveau radeon", use "" to disable completely. + +#RUNTIME_PM_DRIVER_DENYLIST="mei_me nouveau radeon" + +# Permanently enable/disable Runtime PM for listed PCIe device addresses +# (independent of the power source). This has priority over all preceding +# Runtime PM settings. Separate multiple addresses with spaces. +# Use lspci to get the adresses (1st column). +# Default: <none> + +#RUNTIME_PM_ENABLE="11:22.3" +#RUNTIME_PM_DISABLE="44:55.6" + +# Set to 0 to disable, 1 to enable USB autosuspend feature. +# Default: 1 + +#USB_AUTOSUSPEND=1 + +# Exclude listed devices from USB autosuspend (separate with spaces). +# Use lsusb to get the ids. +# Note: input devices (usbhid) and libsane-supported scanners are excluded +# automatically. +# Default: <none> + +#USB_DENYLIST="1111:2222 3333:4444" + +# Exclude audio devices from USB autosuspend: +# 0=do not exclude, 1=exclude. +# Default: 1 + +#USB_EXCLUDE_AUDIO=1 + +# Exclude bluetooth devices from USB autosuspend: +# 0=do not exclude, 1=exclude. +# Default: 0 + +#USB_EXCLUDE_BTUSB=0 + +# Exclude phone devices from USB autosuspend: +# 0=do not exclude, 1=exclude (enable charging). +# Default: 0 + +#USB_EXCLUDE_PHONE=0 + +# Exclude printers from USB autosuspend: +# 0=do not exclude, 1=exclude. +# Default: 1 + +#USB_EXCLUDE_PRINTER=1 + +# Exclude WWAN devices from USB autosuspend: +# 0=do not exclude, 1=exclude. +# Default: 0 + +#USB_EXCLUDE_WWAN=0 + +# Allow USB autosuspend for listed devices even if already denylisted or +# excluded above (separate with spaces). Use lsusb to get the ids. +# Default: 0 + +#USB_ALLOWLIST="1111:2222 3333:4444" + +# Set to 1 to disable autosuspend before shutdown, 0 to do nothing +# Note: use as a workaround for USB devices that cause shutdown problems. +# Default: 0 + +#USB_AUTOSUSPEND_DISABLE_ON_SHUTDOWN=0 + +# Restore radio device state (Bluetooth, WiFi, WWAN) from previous shutdown +# on system startup: 0=disable, 1=enable. +# Note: the parameters DEVICES_TO_DISABLE/ENABLE_ON_STARTUP/SHUTDOWN below +# are ignored when this is enabled. +# Default: 0 + +#RESTORE_DEVICE_STATE_ON_STARTUP=0 + +# Radio devices to disable on startup: bluetooth, nfc, wifi, wwan. +# Separate multiple devices with spaces. +# Default: <none> + +#DEVICES_TO_DISABLE_ON_STARTUP="bluetooth nfc wifi wwan" + +# Radio devices to enable on startup: bluetooth, nfc, wifi, wwan. +# Separate multiple devices with spaces. +# Default: <none> + +#DEVICES_TO_ENABLE_ON_STARTUP="wifi" + +# Radio devices to disable on shutdown: bluetooth, nfc, wifi, wwan. +# Note: use as a workaround for devices that are blocking shutdown. +# Default: <none> + +#DEVICES_TO_DISABLE_ON_SHUTDOWN="bluetooth nfc wifi wwan" + +# Radio devices to enable on shutdown: bluetooth, nfc, wifi, wwan. +# (to prevent other operating systems from missing radios). +# Default: <none> + +#DEVICES_TO_ENABLE_ON_SHUTDOWN="wwan" + +# Radio devices to enable on AC: bluetooth, nfc, wifi, wwan. +# Default: <none> + +#DEVICES_TO_ENABLE_ON_AC="bluetooth nfc wifi wwan" + +# Radio devices to disable on battery: bluetooth, nfc, wifi, wwan. +# Default: <none> + +#DEVICES_TO_DISABLE_ON_BAT="bluetooth nfc wifi wwan" + +# Radio devices to disable on battery when not in use (not connected): +# bluetooth, nfc, wifi, wwan. +# Default: <none> + +#DEVICES_TO_DISABLE_ON_BAT_NOT_IN_USE="bluetooth nfc wifi wwan" + +# Battery Care -- Charge thresholds +# Charging starts when the charger is connected and the charge level +# is below the start threshold. Charging stops when the charge level +# is above the stop threshold. +# Required hardware: Lenovo ThinkPads and select other laptop brands +# are driven via specific plugins +# - Active plugin and support status are shown by tlp-stat -b +# - Vendor specific threshold levels are shown by tlp-stat -b, some +# laptops support only 1 (on)/ 0 (off) instead of a percentage level +# - When your hardware supports a start *and* a stop threshold, you must +# specify both, otherwise TLP will refuse to apply the single threshold +# - When your hardware supports only a stop threshold, set the start +# value to 0 +# - Older ThinkPads may require an external kernel module, refer to the +# output of tlp-stat -b +# For further explanation and vendor specific details refer to +# - https://linrunner.de/tlp/settings/battery.html +# - https://linrunner.de/tlp/settings/bc-vendors.html + +# BAT0: Primary / Main / Internal battery +# Note: also use for batteries BATC, BATT and CMB0 +# Default: <none> + +# Battery charge level below which charging will begin. +START_CHARGE_THRESH_BAT0=80 +# Battery charge level above which charging will stop. +STOP_CHARGE_THRESH_BAT0=90 + +# BAT1: Secondary / Ultrabay / Slice / Replaceable battery +# Note: primary on some laptops +# Default: <none> + +# Battery charge level below which charging will begin. +#START_CHARGE_THRESH_BAT1=75 +# Battery charge level above which charging will stop. +#STOP_CHARGE_THRESH_BAT1=80 + +# Restore charge thresholds when AC is unplugged: 0=disable, 1=enable. +# Default: 0 + +RESTORE_THRESHOLDS_ON_BAT=1 + +# Control battery care drivers: 0=disable, 1=enable. +# Default: 1 (all) + +#NATACPI_ENABLE=1 +#TPACPI_ENABLE=1 +#TPSMAPI_ENABLE=1 + +# ------------------------------------------------------------------------------ +# tlp-rdw - Parameters for the radio device wizard + +# Possible devices: bluetooth, wifi, wwan. +# Separate multiple radio devices with spaces. +# Default: <none> (for all parameters below) + +# Radio devices to disable on connect. + +#DEVICES_TO_DISABLE_ON_LAN_CONNECT="wifi wwan" +#DEVICES_TO_DISABLE_ON_WIFI_CONNECT="wwan" +#DEVICES_TO_DISABLE_ON_WWAN_CONNECT="wifi" + +# Radio devices to enable on disconnect. + +#DEVICES_TO_ENABLE_ON_LAN_DISCONNECT="wifi wwan" +#DEVICES_TO_ENABLE_ON_WIFI_DISCONNECT="" +#DEVICES_TO_ENABLE_ON_WWAN_DISCONNECT="" + +# Radio devices to enable/disable when docked. + +#DEVICES_TO_ENABLE_ON_DOCK="" +#DEVICES_TO_DISABLE_ON_DOCK="" + +# Radio devices to enable/disable when undocked. + +#DEVICES_TO_ENABLE_ON_UNDOCK="wifi" +#DEVICES_TO_DISABLE_ON_UNDOCK="" diff --git a/misc/.bashrc b/misc/.bashrc index 5f8c3cf..2d44565 100644 --- a/misc/.bashrc +++ b/misc/.bashrc @@ -18,7 +18,9 @@ _checkexec () } # Machine-specific and personal settings -source ~/.bashrc_local +if [[ -f ~/.bashrc_local ]]; then + source ~/.bashrc_local +fi ## prompts # git prompt @@ -26,6 +28,8 @@ if [[ -f /usr/share/git/completion/git-prompt.sh ]]; then source /usr/share/git/completion/git-prompt.sh elif [[ -f /etc/bash_completion.d/git-prompt ]]; then source /etc/bash_completion.d/git-prompt +elif [[ -f /usr/share/git-core/contrib/completion/git-prompt.sh ]]; then + source /usr/share/git-core/contrib/completion/git-prompt.sh fi # prompt @@ -63,7 +67,9 @@ then fi # from ~/.bashrc_local, adding more to PATH -my_local_add_path +if [[ $(type -t my_local_add_path) == function ]]; then + my_local_add_path +fi export PATH @@ -109,7 +115,7 @@ export HISTCONTROL=ignoreboth # aliases test -s ~/.alias && . ~/.alias || true alias shutdown='sudo /sbin/shutdown -hP now' -alias reboot='sudo /sbin/reboot' +alias reboot='sudo reboot' alias wifi-menu='sudo /usr/bin/wifi-menu' alias cd-='cd -' alias cd#='cd ~' @@ -125,6 +131,8 @@ alias updatedb='sudo updatedb' alias wgets="wget -O- 2>/dev/null" # get url behind one redirection alias wgre="wget --spider --max-redirect=0" +# wget with spoofing googlebot +alias wggb='wget --header="X-Forwarded-For: 66.249.66.1" --user-agent="Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)"' # this allows to open an url with tor-browser from within emacs, see # `my-browse-url-tor-browser' alias tor-browser="tor-browser --allow-remote" @@ -177,6 +185,7 @@ then alias pQi="pacman -Qi" # local package details alias pQl="pacman -Ql" # local package file lists alias pQo="pacman -Qo" # which package owns this file + alias pQc="pacman -Qc" # show changelog # Remove packages alias pRs="sudo pacman -Rs" # remove package @@ -187,10 +196,28 @@ then # Clear cache alias pcache1="sudo paccache -rk 1" # remove cache except last item alias pcache0="sudo paccache -ruk0" # remove all cache + + # make an aur package + paur () { + pkg_name="${1%.tar.gz}" + tar xvf "$pkg_name.tar.gz" + cd "$pkg_name" + makepkg + } fi +alias systart="sudo systemctl start" +alias systop="sudo systemctl stop" +alias sysnow="sudo systemctl enable --now" +alias sysdis="sudo systemctl disable" +alias systat="systemctl status" +alias sysres="sudo systemctl restart" +alias sysrelo="sudo systemctl reload" + # from ~/.bashrc_local, more aliases -my_local_aliases +if [[ $(type -t my_local_aliases) == function ]]; then + my_local_aliases +fi #ibus export GTK_IM_MODULE=ibus @@ -200,6 +227,26 @@ export QT_IM_MODULE=ibus #fix small vlc interface export QT_AUTO_SCREEN_SCALE_FACTOR=0 +# ensure $XDG_RUNTIME_DIR is set +if [ -z "$XDG_RUNTIME_DIR" ]; then # It's not already set + XDG_RUNTIME_DIR=/run/user/$UID # Try systemd created path + if [ ! -d "$XDG_RUNTIME_DIR" ]; then + # systemd-created directory doesn't exist + XDG_RUNTIME_DIR=/tmp/$USER-runtime + if [ ! -d "$XDG_RUNTIME_DIR" ]; then # Doesn't already exist + mkdir -m 0700 "$XDG_RUNTIME_DIR" + fi + fi +fi +# Check dir has got the correct type, ownership, and permissions +if ! [[ -d "$XDG_RUNTIME_DIR" && -O "$XDG_RUNTIME_DIR" && + "$(stat -c '%a' "$XDG_RUNTIME_DIR")" = 700 ]]; then + echo "\$XDG_RUNTIME_DIR: permissions problem with $XDG_RUNTIME_DIR:" >&2 + ls -ld "$XDG_RUNTIME_DIR" >&2 + XDG_RUNTIME_DIR=$(mktemp -d /tmp/"$USER"-runtime-XXXXXX) + echo "Set \$XDG_RUNTIME_DIR=$XDG_RUNTIME_DIR" >&2 +fi + # start the agent automatically and make sure that only one # ssh-agent process runs at a time if ! pgrep -u "$USER" ssh-agent > /dev/null; then @@ -220,4 +267,21 @@ export CCACHE_EXEC=/usr/bin/ccache export CVS_RSH="ssh" # from ~/.bashrc_local, export more stuff -my_local_export +if [[ $(type -t my_local_export) == function ]]; then + my_local_export +fi + +# ghostscript, extract pages into a new file +# gs-extract 4 11 page-4-thru-11.pdf original.pdf +gs-extract() { + gs -sDEVICE=pdfwrite -dNOPAUSE -dBATCH -dSAFER -dFirstPage=$1 -dLastPage=$2 \ + -sOutputFile="$3" "$4" +} + +# ghostscript, merge files: gs-merge merged.pdf 1.pdf 2.pdf +gs-merge() { + gs -dBATCH -dNOPAUSE -q -sDEVICE=pdfwrite -sOutputFile="$@" +} + +# dptrp1 +alias quaderno="dptrp1 --addr $QUADERNO_IP" diff --git a/misc/.config/i3/config b/misc/.config/i3/config index 1fd7942..803dcd1 100644 --- a/misc/.config/i3/config +++ b/misc/.config/i3/config @@ -13,7 +13,7 @@ set $mod Mod4 # Font for window titles. Will also be used by the bar unless a different font # is used in the bar {} block below. -font pango:monospace 8 +font pango:Ubuntu Mono Bold 9 # This font is widely installed, provides lots of unicode glyphs, right-to-left # text rendering and scalability on retina/hidpi displays (thanks to pango). @@ -175,6 +175,9 @@ bindsym $mod+Up exec --no-startup-id pactl set-sink-volume @DEFAULT_SINK@ +5% bindsym $mod+Down exec --no-startup-id pactl set-sink-volume @DEFAULT_SINK@ -5% # Sreen brightness controls +# may need to add rule for users in video group to do without sudo: +# /etc/udev/rules.d/backlight.rules: +# ACTION=="add", SUBSYSTEM=="backlight", RUN+="/bin/chgrp video $sys$devpath/brightness", RUN+="/bin/chmod g+w $sys$devpath/brightness" bindsym XF86MonBrightnessUp exec xbacklight -inc 20 # increase screen brightness bindsym XF86MonBrightnessDown exec xbacklight -dec 20 # decrease screen brightness @@ -208,3 +211,4 @@ bindsym $mod+minus exec dunstctl close exec ibus-daemon exec redshift-gtk exec --no-startup-id i3-msg 'workspace $ws1; exec urxvt' +exec xscreensaver -no-splash & diff --git a/misc/.config/i3status/config b/misc/.config/i3status/config index a276e19..4b7725a 100644 --- a/misc/.config/i3status/config +++ b/misc/.config/i3status/config @@ -13,6 +13,7 @@ general { order += "read_file emms" order += "wireless _first_" +order += "read_file VPN" order += "battery all" order += "disk /" order += "disk /home" @@ -38,6 +39,13 @@ ethernet _first_ { format_down = "E: down" } +# in collaboration with check-ovpn.sh +read_file VPN { + format = "VPN: %content" + format_bad = "VPN: NO" + path = "~/.local/ovpn-up" +} + battery all { format = "%status %percentage %remaining" } diff --git a/misc/.config/mimeapps.list b/misc/.config/mimeapps.list index 7648543..413a9f5 100644 --- a/misc/.config/mimeapps.list +++ b/misc/.config/mimeapps.list @@ -20,10 +20,10 @@ application/x-extension-xhtml=firefox.desktop application/xhtml+xml=firefox.desktop application/xml=emacsclient.desktop application/zip=emacsclient.desktop -image/png=geeqie.desktop -image/jpeg=geeqie.desktop +image/png=org.geeqie.Geeqie.desktop +image/jpeg=org.geeqie.Geeqie.desktop inode/directory=emacsclient.desktop -image/webp=geeqie.desktop +image/webp=org.geeqie.Geeqie.desktop message/rfc822=emacsclient-mail.desktop text/csv=libreoffice-calc.desktop text/html=firefox.desktop @@ -36,8 +36,8 @@ video/quicktime=vlc.desktop video/x-msvideo=mpv.desktop x-scheme-handler/chrome=firefox.desktop x-scheme-handler/ftp=filezilla.desktop -x-scheme-handler/http=firefox.desktop -x-scheme-handler/https=firefox.desktop +x-scheme-handler/http=emacsclient-web.desktop +x-scheme-handler/https=emacsclient-web.desktop x-scheme-handler/mailto=emacsclient-mail.desktop x-scheme-handler/sgnl=signal-desktop.desktop x-scheme-handler/org-protocol=emacsclient-org-protocol.desktop @@ -45,3 +45,4 @@ x-scheme-handler/org-protocol=emacsclient-org-protocol.desktop [Added Associations] application/pdf=org.pwmt.zathura-pdf-poppler.desktop;firefox.desktop text/csv=emacsclient.desktop +image/heif=org.geeqie.Geeqie.desktop; diff --git a/misc/.config/mpv/input.conf b/misc/.config/mpv/input.conf new file mode 100644 index 0000000..0238138 --- /dev/null +++ b/misc/.config/mpv/input.conf @@ -0,0 +1,3 @@ +PREV seek -15 +NEXT stop +a vf toggle hflip diff --git a/misc/.config/mpv/mpv.conf b/misc/.config/mpv/mpv.conf new file mode 100644 index 0000000..3b49398 --- /dev/null +++ b/misc/.config/mpv/mpv.conf @@ -0,0 +1,31 @@ +save-position-on-quit +# Uncomment this line to load the profile by default +# Otherwise, use `--profile=emacsconf-talks` +# profile=emacsconf-talks + +script-opts=ytdl_hook-ytdl_path=/usr/bin/yt-dlp +ytdl-format="bestvideo[height<=?720]+bestaudio/best" +osc=no +stop-screensaver = "yes" + +[emacsconf-talks] +# Positioning +video-zoom=-0.15 +video-pan-y=-0.055 +sub-use-margins=yes +sub-scale-by-window=yes +sub-pos=103 +sub-margin-x=150 +sub-margin-y=40 +# Style +sub-font="Clear Sans Bold" +sub-color="1/0.82/0" +sub-blur=0.2 +sub-scale=0.9 +sub-font-size=40 +sub-border-size=0 +sub-border-color=0/1 +sub-shadow-color=0/1 +sub-shadow-offset=1.2 +sub-ass-force-style=Kerning=yes +sub-ass-line-spacing=0 diff --git a/misc/.config/rofi/config.rasi b/misc/.config/rofi/config.rasi index aab83de..041b095 100644 --- a/misc/.config/rofi/config.rasi +++ b/misc/.config/rofi/config.rasi @@ -33,7 +33,7 @@ configuration { /* parse-hosts: false;*/ /* parse-known-hosts: true;*/ combi-modes: "run,drun"; - matching: "glob"; + matching: "prefix"; /* tokenize: true;*/ /* m: "-5";*/ /* filter: ;*/ diff --git a/misc/.gdbinit b/misc/.gdbinit index b2c8a1f..b06bc7f 100644 --- a/misc/.gdbinit +++ b/misc/.gdbinit @@ -1,3 +1,5 @@ +set debuginfod enabled on +set max-completions 20 set print static-members off set print frame-arguments all # unlimited print string length @@ -19,6 +21,10 @@ alias wl = watch -l alias awl = awatch -l alias rwl = rwatch -l alias rt = restart +define bc + b $arg0 + c +end # Print backtrace of all threads alias abt = thread apply all bt set history save on diff --git a/misc/.inputrc b/misc/.inputrc new file mode 100644 index 0000000..9ef6cbc --- /dev/null +++ b/misc/.inputrc @@ -0,0 +1,12 @@ +# Reduce tab completion key presses and show suggestions +set show-all-if-ambiguous on +# Color files by types +set colored-stats On +# Append char to indicate type +set visible-stats On +# Mark symlinked directories +set mark-symlinked-directories On +# Color the common prefix +set colored-completion-prefix On +# Color the common prefix in menu-complete +set menu-complete-display-prefix On diff --git a/misc/.kodi/userdata/playercorefactory.xml b/misc/.kodi/userdata/playercorefactory.xml new file mode 100644 index 0000000..ef9d7e4 --- /dev/null +++ b/misc/.kodi/userdata/playercorefactory.xml @@ -0,0 +1,14 @@ +<playercorefactory> + <players> + <player name="VLC" type="ExternalPlayer" audio="false" video="true"> + <filename>/usr/bin/vlc</filename> + <args>"{1}" -f --video-on-top</args> + <hidexbmc>true</hidexbmc> + <warpcursor>none</warpcursor> + </player> + </players> + + <rules action="prepend"> + <rule name="Playtype" filetype="mkv|mp4|avi|webm|ogv" player="VLC"/> + </rules> +</playercorefactory> diff --git a/misc/.local/share/applications/emacsclient-web.desktop b/misc/.local/share/applications/emacsclient-web.desktop new file mode 100644 index 0000000..5beb0f3 --- /dev/null +++ b/misc/.local/share/applications/emacsclient-web.desktop @@ -0,0 +1,20 @@ +[Desktop Entry] +Categories=Network;Web; +Comment=GNU Emacs is an extensible, customizable text editor - and more +Exec=/usr/bin/emacsclient -n %u +Icon=emacs +Name=Emacs (Web Browser, Client) +MimeType=x-scheme-handler/http;x-scheme-handler/https; +NoDisplay=true +Terminal=false +Type=Application +Keywords=emacsclient; +Actions=new-window;new-instance; + +[Desktop Action new-window] +Name=New Window +Exec=/usr/bin/emacsclient --create-frame -n %u + +[Desktop Action new-instance] +Name=New Instance +Exec=emacs -f browse-url %u diff --git a/misc/.screenrc b/misc/.screenrc new file mode 100644 index 0000000..934d3af --- /dev/null +++ b/misc/.screenrc @@ -0,0 +1,7 @@ +autodetach on +startup_message off +hardstatus alwayslastline +shelltitle 'bash' + +hardstatus string '%{gk}[%{wk}%?%-Lw%?%{=b kR}(%{W}%n*%f %t%?(%u)%?%{=b kR})%{= w}%?%+Lw%?%? %{g}][%{d}%l%{g}][ %{= w}%Y/%m/%d %0C:%s%a%{g} ]%{W}' +escape ^\\\ diff --git a/misc/bin/check-ovpn.sh b/misc/bin/check-ovpn.sh new file mode 100755 index 0000000..9669190 --- /dev/null +++ b/misc/bin/check-ovpn.sh @@ -0,0 +1,12 @@ +#!/bin/bash + +# Check that the vpn is up. Check every 5 seconds for 11 times - for +# use as a minutely cron task +for i in $(seq 1 11); do + if ifconfig | grep -q "00-00-00-00-00-00-00-00-00-00-00-00-00-00-00-00"; then + echo YES > ~/.local/ovpn-up + else + rm -f ~/.local/ovpn-up + fi + sleep 5 +done diff --git a/misc/bin/display_toggle.sh b/misc/bin/display_toggle.sh index b2c7e5c..e7dfcf5 100755 --- a/misc/bin/display_toggle.sh +++ b/misc/bin/display_toggle.sh @@ -1,11 +1,14 @@ #!/bin/bash -# Assuming there are two displays. A small one (e.g. laptop) and a big -# one (e.g. monitor). Identify the displays, and toggle between 3 -# states: small one only -> both with the big one to the left of the -# small one -> big one only -# small one: <20 inch -# big one: >20 inch +# toggle display arrangements. + +# If there is only one monitor, then run xrandr --auto + +# Otherwise assume there are two displays. A small one (e.g. laptop) +# and a big one (e.g. monitor). Identify the displays, and toggle +# between 3 states: small one only -> both with the big one to the +# left of the small one -> big one only small one: <20 inch big one: +# >20 inch # Make sure the variables from pipe can be assigned # https://stackoverflow.com/questions/42963395/bash-assign-variable-from-pipe @@ -21,9 +24,10 @@ xrandr | grep " connected " | while IFS=$'\n' read -r line; do fi done +# Only one monitor: run xrandr --auto if (( i == 1 )); then - echo "Only one connected display" - exit 1 + xrandr --auto + exit 0 fi regex="^.*/([0-9]+)x.*/([0-9]+).* ([^ ]+)$" diff --git a/misc/bin/switch-display.sh b/misc/bin/switch-display.sh new file mode 100755 index 0000000..4c3cba6 --- /dev/null +++ b/misc/bin/switch-display.sh @@ -0,0 +1,35 @@ +#!/bin/bash + +logger "$1" "$2" "$3" +# Switch to the biggest display available. for use as an acpid hook + +# Make sure the variables from pipe can be assigned +# https://stackoverflow.com/questions/42963395/bash-assign-variable-from-pipe +shopt -s lastpipe + +# enable all monitors so that they show up in xrandr +# --listactivemonitors output. somehow this output is identical to +# that of xrandr --listmonitors +xrandr --auto + +# find the widest monitor +regex="^.*/([0-9]+)x.*/([0-9]+).* ([^ ]+)$" +widest=0 +widest_name="" +xrandr --listactivemonitors | while IFS=$'\n' read -r line; do + if [[ $line =~ $regex ]]; then + if (( "${BASH_REMATCH[1]}" > "$widest" )); then + widest="${BASH_REMATCH[1]}" + widest_name="${BASH_REMATCH[3]}" + fi + fi +done + +# turn off all other monitors +xrandr --listactivemonitors | while IFS=$'\n' read -r line; do + if [[ $line =~ $regex ]]; then + if [[ "${BASH_REMATCH[3]}" != "$widest_name" ]]; then + xrandr --output "${BASH_REMATCH[3]}" --off + fi + fi +done diff --git a/misc/bin/unzipall.sh b/misc/bin/unzipall.sh new file mode 100755 index 0000000..2d654f0 --- /dev/null +++ b/misc/bin/unzipall.sh @@ -0,0 +1,8 @@ +#/bin/bash + +# unzip all zip/7z files with 7z in pwd +for f in ./*; do + ext=${f##*.} + if test "$ext" = zip; then 7z e "$f"; fi; + if test "$ext" = 7z; then 7z e "$f"; fi; +done diff --git a/misc/bin/zipall.sh b/misc/bin/zipall.sh new file mode 100755 index 0000000..0a244c2 --- /dev/null +++ b/misc/bin/zipall.sh @@ -0,0 +1,9 @@ +#/bin/bash + +# zip all non-7z and non-zip files with 7z in pwd and delete the original +for f in ./*; do + ext=${f##*.} + if test "$ext" = zip; then continue; fi; + if test "$ext" = 7z; then continue; fi; + 7z a -sdel "$f.7z" "$f" +done |