diff options
Diffstat (limited to 'emacs/.emacs.d')
102 files changed, 11369 insertions, 0 deletions
diff --git a/emacs/.emacs.d/early-init.el b/emacs/.emacs.d/early-init.el new file mode 100644 index 0000000..59c9a84 --- /dev/null +++ b/emacs/.emacs.d/early-init.el @@ -0,0 +1,92 @@ +;;; early-init.el -- Early init -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; John Wiegley <johnw@newartisans.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Early init. + +;;; Code: + +(defconst my-emacs-start-time (current-time)) + +;; Use this to control what kind of emacs we want to use. For emms, +;; erc, home, or work etc. +(defvar my-profile (getenv "EMACS_PROFILE")) + +;;; Copied from John Wiegley's .emacs file +(defun my-report-time-since-load (&optional suffix) + (message "Loading init...done (%.3fs)%s" + (float-time (time-subtract (current-time) my-emacs-start-time)) + suffix)) + +(add-hook 'after-init-hook + #'(lambda () (my-report-time-since-load " [after-init]")) + t) + +;; Much of the following is copied from prot-dotfiles +;; Disable the damn thing by making it disposable. +(setq custom-file (make-temp-file "emacs-custom-")) + +(menu-bar-mode -1) +(scroll-bar-mode -1) +(tool-bar-mode -1) + +(setq frame-resize-pixelwise t + frame-inhibit-implied-resize t) + +(setq use-dialog-box t ; only for mouse events + use-file-dialog nil + inhibit-splash-screen t + inhibit-startup-screen t + inhibit-x-resources t + inhibit-startup-echo-area-message user-login-name ; read the docstring + inhibit-startup-buffer-menu t + make-backup-files nil + backup-inhibited nil ; Not sure if needed, given `make-backup-files' + create-lockfiles nil) + +;; Temporarily increase the garbage collection threshold. These +;; changes help shave off about half a second of startup time. +(defvar my-emacs--gc-cons-threshold gc-cons-threshold) + +(setq gc-cons-threshold most-positive-fixnum) + +(add-hook 'emacs-startup-hook + (lambda () + (setq gc-cons-threshold my-emacs--gc-cons-threshold))) + +;; Initialise installed packages +(setq package-enable-at-startup t) + +(defvar package-quickstart) + +;; Allow loading from the package cache +(setq package-quickstart t) + +(when (native-comp-available-p) + (setq native-comp-async-report-warnings-errors 'silent) ; emacs28 with native compilation + (setq native-compile-prune-cache t)) ; Emacs 29 + +;;; early-init.el ends here diff --git a/emacs/.emacs.d/init.el b/emacs/.emacs.d/init.el new file mode 100644 index 0000000..2d229b9 --- /dev/null +++ b/emacs/.emacs.d/init.el @@ -0,0 +1,63 @@ +;;; init.el -- My emacs init file -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My emacs init file. + +;;; Code: + + + +(add-to-list 'load-path (locate-user-emacs-file "init")) +(dolist (lib (directory-files + (locate-user-emacs-file "lisp") + t directory-files-no-dot-files-regexp)) + (add-to-list 'load-path lib)) + +;;; Defines basic macros and should be the first require +(require 'my-package) +;;; Declares what packages to include and read `my-local-config' +;;; etc. and should be the second require +(require 'ycp-package) + +(require 'ycp-basic) +(require 'ycp-buffer) +(require 'ycp-help) +(require 'ycp-theme) +(require 'ycp-complete) +(require 'ycp-dired) +(require 'ycp-editing) +(require 'ycp-prog) +(require 'ycp-vc) +(require 'ycp-grep) +(require 'ycp-web) +(require 'ycp-time) +(require 'ycp-markup) +(require 'ycp-pdf) +(require 'ycp-project) +(require 'ycp-org) +(require 'ycp-system) +(require 'ycp-client) +(require 'ycp-emms) +(require 'ycp-gnus) +(require 'ycp-fun) diff --git a/emacs/.emacs.d/init/ycp-basic.el b/emacs/.emacs.d/init/ycp-basic.el new file mode 100644 index 0000000..07bb11f --- /dev/null +++ b/emacs/.emacs.d/init/ycp-basic.el @@ -0,0 +1,60 @@ +;;; ycp-basic.el -- My config for basic stuff -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for basic stuff. + +;;; Code: + + +(setq use-short-answers t) +(prefer-coding-system 'utf-8) +(set-default-coding-systems 'utf-8) +(set-terminal-coding-system 'utf-8) +(set-keyboard-coding-system 'utf-8) +(set-language-environment 'utf-8) + +(my-configure + (my-keybind global-map + "C-x C-c" nil + "C-x C-c C-c" #'save-buffers-kill-emacs + "C-x C-z" nil + ) + (setq auth-source-save-behavior nil) + ) + +(my-configure + (:delay 5) + (require 'my-utils) + (my-keybind global-map + "C-c <f2>" #'my-rename-file-and-buffer + "C-c <delete>" #'my-delete-file-and-kill-buffer + "C-g" #'my-keyboard-quit-dwim + ) +) + +(provide 'ycp-basic) +;;; ycp-basic.el ends here diff --git a/emacs/.emacs.d/init/ycp-buffer.el b/emacs/.emacs.d/init/ycp-buffer.el new file mode 100644 index 0000000..56bcf08 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-buffer.el @@ -0,0 +1,239 @@ +;;; ycp-buffer.el -- My config for buffers, windows, frames etc. -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for buffers, windows, frames etc.. + +;;; Code: + + +(my-package my-buffer + (:delay 15) + (my-keybind global-map + "\M-c" #'my-copy-buffer-file-name + "<C-f2>" #'my-rename-file-and-buffer + "C-x k" #'my-kill-buffer + "M-s b" #'my-switch-to-buffer-matching-major-mode + "M-s v" #'my-buffers-vc-root + ;; F7: Cycle or create buffers with the same base buffer as the + ;; current buffer + "<f7>" #'my-create-or-switch-indirect-buffers + ;; F8: Cycle or create buffers with the same major mode as the + ;; current buffer + "<f8>" #'my-buffer-create-or-cycle-same-mode + ;; F9: Prompt for a mode, then switch to or create a buffer of + ;; that mode + "<f9>" #'my-buffer-switch-or-create-major-mode + ) + ) + +(my-configure + (:delay 15) + (my-keybind ctl-x-x-map + "f" #'follow-mode ; override `font-lock-update' + "r" #'rename-uniquely + "l" #'visual-line-mode) + + ;; make ibuffer default + (advice-add 'list-buffers :override 'ibuffer-list-buffers) + + ;; In Emacs 27+, use Control + mouse wheel to scale text. + (setq mouse-wheel-scroll-amount + '(1 + ((shift) . 5) + ((meta) . 0.5) + ((control) . text-scale)) + mouse-drag-copy-region nil + make-pointer-invisible t + mouse-wheel-progressive-speed t + mouse-wheel-follow-mouse t) + + ;; Scrolling behaviour + (setq-default scroll-conservatively 1 ; affects `scroll-step' + scroll-margin 0 + next-screen-context-lines 0) + + (mouse-wheel-mode 1) + (define-key global-map (kbd "C-M-<mouse-3>") #'tear-off-window)) + +;;; Repeatable key chords (repeat-mode) +(my-package repeat + (:delay 30) + (setq repeat-on-final-keystroke t + repeat-exit-timeout 5 + repeat-exit-key "<escape>" + repeat-keep-prefix nil + repeat-check-key t + repeat-echo-function 'ignore + ;; Technically, this is not in repeal.el, though it is the + ;; same idea. + set-mark-command-repeat-pop t) + (repeat-mode 1)) + +;;;; Built-in bookmarking framework (bookmark.el) +(my-package bookmark + (setq bookmark-use-annotations nil) + (setq bookmark-automatically-show-annotations t) + (add-hook 'bookmark-bmenu-mode-hook #'hl-line-mode)) + +(my-package follow + (:delay 15) + ;; TODO: update this to adapt to number of windows + (my-keybind follow-mode-map + "C-v" #'follow-scroll-up + "M-v" #'follow-scroll-down + "<next>" #'follow-scroll-up + "<prior>" #'follow-scroll-down) + ) + +(my-package view + (:delay 10) + (my-keybind view-mode-map + "n" #'next-line + "p" #'previous-line + "f" #'forward-char + "b" #'backward-char + "e" #'move-end-of-line + "a" #'move-beginning-of-line + "v" #'scroll-up-command + "V" #'scroll-down-command + "l" #'previous-buffer + "r" #'next-buffer + "d" nil + "u" nil + "w" #'kill-ring-save + "i" #'view-mode) + (my-keybind global-map "C-`" #'view-mode)) + +;; move windows +(my-package windmove + (:delay 5) + (windmove-default-keybindings 'control) + ;; swap windows + (windmove-swap-states-default-keybindings '(control shift)) + (setq windmove-wrap-around t)) + +(my-package winner + (:delay 5) + (winner-mode t)) + +;;;; `window', `display-buffer-alist', and related +(my-package window + (require 'time) + (require 'my-buffer) + (setq display-buffer-alist + `(;; no window + ("\\`\\*Async Shell Command\\*\\'" + (display-buffer-no-window) + (dedicated . t)) + ;; bottom side window + ("\\*Org Select\\*" ; the `org-capture' key selection + (display-buffer-in-side-window) + (dedicated . t) + (side . bottom) + (slot . 0) + (window-parameters . ((mode-line-format . none)))) + ;; bottom buffer (NOT side window) + ((or . (,(my-buffer-make-display-matcher + '(flymake-diagnostics-buffer-mode + flymake-project-diagnostics-mode + messages-buffer-mode backtrace-mode)) + "\\*\\(Warnings\\|Compile-Log\\|Org Links\\)\\*" + ,world-clock-buffer-name)) + (display-buffer-reuse-mode-window display-buffer-at-bottom) + (window-height . 0.3) + (dedicated . t) + (preserve-size . (t . t))) + ("\\*\\(Output\\|Register Preview\\).*" + (display-buffer-reuse-mode-window display-buffer-at-bottom)) + ;; below current window + ((derived-mode . help-mode) ; See the hooks for `visual-line-mode' + (display-buffer-reuse-mode-window display-buffer-below-selected)) + ("\\*\\vc-\\(incoming\\|outgoing\\|git : \\).*" + (display-buffer-reuse-mode-window display-buffer-below-selected) + (window-height . 0.1) + (dedicated . t) + (preserve-size . (t . t))) + ((derived-mode . log-view-mode) + (display-buffer-reuse-mode-window display-buffer-below-selected) + (window-height . 0.3) + (dedicated . t) + (preserve-size . (t . t))) + ((derived-mode . reb-mode) ; M-x re-builder + (display-buffer-reuse-mode-window display-buffer-below-selected) + (window-height . 4) ; note this is literal lines, not relative + (dedicated . t) + (preserve-size . (t . t))) + ("\\*\\(Calendar\\|Bookmark Annotation\\).*" + (display-buffer-reuse-mode-window display-buffer-below-selected) + (dedicated . t) + (window-height . fit-window-to-buffer)) + ("\\*ispell-top-choices\\*.*" + (display-buffer-reuse-mode-window display-buffer-below-selected) + (window-height . fit-window-to-buffer)) + ;; same window + + ;; NOTE 2023-02-17: `man' does not fully obey the + ;; `display-buffer-alist'. It works for new frames and for + ;; `display-buffer-below-selected', but otherwise is + ;; unpredictable. See `Man-notify-method'. + ((or . ((derived-mode . Man-mode) + (derived-mode . woman-mode) + "\\*\\(Man\\|woman\\).*" + "\\*shell\\*.*")) + (display-buffer-same-window)) +)) + + (setq switch-to-buffer-in-dedicated-window 'pop) + (setq window-combination-resize t) + (my-keybind resize-window-repeat-map + ">" #'enlarge-window-horizontally + "<" #'shrink-window-horizontally) + ) + +(my-keybind global-map + "C-x C-n" #'next-buffer ; override `set-goal-column' + "C-x C-p" #'previous-buffer ; override `mark-page' + "C-x !" #'delete-other-windows-vertically + "C-x _" #'balance-windows ; underscore + "C-x -" #'fit-window-to-buffer ; hyphen + "C-x +" #'balance-windows-area + "C-x }" #'enlarge-window + "C-x {" #'shrink-window + "C-x >" #'enlarge-window-horizontally ; override `scroll-right' + "C-x <" #'shrink-window-horizontally) ; override `scroll-left' + +(my-package my-buffer + (:delay 10) + (my-keybind global-map + "<f1>" #'my-focus-write + "<insert>" #'my-cycle-windows + "C-M-<mouse-4>" #'my-increase-default-face-height + "C-M-<mouse-5>" #'my-decrease-default-face-height) + ) + +(setq large-file-warning-threshold 15000000) + +(provide 'ycp-buffer) diff --git a/emacs/.emacs.d/init/ycp-client.el b/emacs/.emacs.d/init/ycp-client.el new file mode 100644 index 0000000..def2351 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-client.el @@ -0,0 +1,104 @@ +;;; ycp-client.el -- My config for non-http clients -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for non-http clients. like wget, ytdl, sql, irc, etc + + +;;; Code: + +;;; Note: erc is only allowed when `my-profile' is erc, as assigned in early-init.el +(my-package erc + (setq erc-lurker-hide-list '("JOIN" "PART" "QUIT")) + (setq erc-disable-ctcp-replies t) + (setq erc-modules + '(button completion irccontrols list match menu move-to-prompt + netsplit networks noncommands notifications readonly + ring stamp track)) + (my-setq-from-local erc-track-exclude erc-server erc-nick erc-port) + ;; use auth-source for authentication + (setq erc-prompt-for-password nil) + (setq erc-paranoid t) + (setq erc-fill-mode t) + (require 'erc-match) + (set-face-attribute 'erc-fool-face nil :foreground "white") + (setq erc-fool-highlight-type 'all) + (my-setq-from-local erc-fools) + (erc-tls)) + +(my-package dictionary + (:delay 15) + (autoload 'dictionary-search "dictionary" + "Ask for a word and search it in all dictionaries" t) + (autoload 'dictionary-match-words "dictionary" + "Ask for a word and search all matching words in the dictionaries" t) + (autoload 'dictionary-lookup-definition "dictionary" + "Unconditionally lookup the word at point." t) + (autoload 'dictionary "dictionary" + "Create a new dictionary buffer" t) + (autoload 'dictionary-mouse-popup-matching-words "dictionary" + "Display entries matching the word at the cursor" t) + (autoload 'dictionary-popup-matching-words "dictionary" + "Display entries matching the word at the point" t) + (autoload 'dictionary-tooltip-mode "dictionary" + "Display tooltips for the current word" t) + (autoload 'global-dictionary-tooltip-mode "dictionary" + "Enable/disable dictionary-tooltip-mode for all buffers" t) + (my-keybind global-map + "C-c dd" #'dictionary-search + "C-c dm" #'dictionary-match-words) + (setq dictionary-server "dict.org" + dictionary-default-popup-strategy "lev" ; read doc string + dictionary-create-buttons nil + dictionary-use-single-buffer t)) + +(my-package wget + (:delay 60) + (setq wget-download-directory "~/Downloads") + (setq my-wget-size-threshold (* 20 1024 1024)) + (require 'my-wget) + (my-setq-from-local my-wget-video-archive-directory) + (my-keybind eww-mode-map "s" #'my-eww-wget-save-page) +) + +(my-package my-ytdl + (:delay 60) + (my-setq-from-local my-ytdl-audio-download-dir my-ytdl-video-download-dir)) + +(my-package my-media-segment + (:delay 60)) + +(my-package detached + (:install t) + (:delay 60) + (my-keybind detached-shell-mode-map + "C-<return>" nil + "C-S-<return>" #'detached-attach-session) + (require 'my-detached) + (my-keybind global-map "\M-z" #'my-execute-external-command) +) + +(my-package pactl (:delay 60)) + +(provide 'ycp-client) +;;; ycp-client.el ends here diff --git a/emacs/.emacs.d/init/ycp-complete.el b/emacs/.emacs.d/init/ycp-complete.el new file mode 100644 index 0000000..aed7b3b --- /dev/null +++ b/emacs/.emacs.d/init/ycp-complete.el @@ -0,0 +1,375 @@ +;;; ycp-complete.el -- My config for minibuffer and completions -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for minibuffer and completions. + +;;; Code: + + + +;; completion, minibuffer, corfu, tempel +;; part adapted from prot-dotfiles +(my-package minibuffer + (setq completion-styles '(basic partial-completion emacs22 orderless)) + (setq completion-category-overrides + ;; NOTE 2021-10-25: I am adding `basic' because it works better as a + ;; default for some contexts. Read: + ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=50387>. + ;; + ;; `partial-completion' is a killer app for files, because it + ;; can expand ~/.l/s/fo to ~/.local/share/fonts. + ;; + ;; If `basic' cannot match my current input, Emacs tries the + ;; next completion style in the given order. In other words, + ;; `orderless' kicks in as soon as I input a space or one of its + ;; style dispatcher characters. + '((file (styles . (basic partial-completion orderless))) + (project-file (styles . (basic substring partial-completion orderless))) + (imenu (styles . (emacs22 substring orderless))) + (kill-ring (styles . (emacs22 substring orderless))) + (consult-location (styles . (emacs22 substring orderless))) + (eglot (styles . (emacs22 substring orderless))))) + (setq completion-ignore-case t) + (setq read-buffer-completion-ignore-case t) + (setq read-file-name-completion-ignore-case t) + ;; disable space to run minibuffer-complete-word + (my-keybind minibuffer-mode-map + "SPC" nil + "?" nil) + (my-keybind minibuffer-local-completion-map + "SPC" nil + "?" nil) + (setq enable-recursive-minibuffers t) + (minibuffer-depth-indicate-mode 1) + (setq resize-mini-windows t) + (setq read-answer-short t) + (setq echo-keystrokes 0.25) + ;; Do not allow the cursor to move inside the minibuffer prompt. I + ;; got this from the documentation of Daniel Mendler's Vertico + ;; package: <https://github.com/minad/vertico>. + (setq minibuffer-prompt-properties + '(read-only t cursor-intangible t face minibuffer-prompt)) + (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode) + (minibuffer-electric-default-mode 1)) + +;;;; `savehist' (minibuffer and related histories) +(my-package savehist + (setq savehist-file (locate-user-emacs-file "savehist")) + (setq history-length 500) + (setq history-delete-duplicates t) + (setq savehist-save-minibuffer-history t) + (setq savehist-additional-variables '(register-alist kill-ring)) + (savehist-mode 1)) + +;;;; `dabbrev' (dynamic word completion (dynamic abbreviations)) +(my-package dabbrev + (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_") + (setq dabbrev-abbrev-skip-leading-regexp "[$*/=~']") + (setq dabbrev-backward-only nil) + (setq dabbrev-case-distinction 'case-replace) + (setq dabbrev-case-fold-search nil) + (setq dabbrev-case-replace 'case-replace) + (setq dabbrev-check-other-buffers t) + (setq dabbrev-eliminate-newlines t) + (setq dabbrev-upcase-means-case-search t)) + +;;; icomplete +(my-package icomplete + (icomplete-vertical-mode t) + (setq icomplete-show-matches-on-no-input t) + (setq icomplete-prospects-height 4) + (setq icomplete-scroll t) + (setq icomplete-matches-format "[%s/%s] ") + (require 'my-complete) + (my-keybind icomplete-minibuffer-map + "<tab>" #'icomplete-force-complete + "M-<tab>" #'minibuffer-complete + "C-M-i" #'minibuffer-complete + "C-s" #'icomplete-forward-completions + "C-r" #'icomplete-backward-completions + "C-v" #'my-icomplete-vertical-forward-page + "M-v" #'my-icomplete-vertical-backward-page)) + +(my-package recentf + (setq recentf-max-saved-items 1000) + (setq + recentf-exclude + '("~\\'" "\\`out\\'" "\\.log\\'" "^/[^/]*:" "\\.el\\.gz\\'" "~$" "/mnt/" + "^/tmp/")) + (recentf-mode 1) + ;; disable recentf-save-list on quit on non-emacs-client so that it does not + ;; overwrite the recentf file + (require 'my-utils) + (unless (my-server-p) + (setq kill-emacs-hook (delete 'recentf-save-list kill-emacs-hook))) + (require 'my-complete) + (my-server-timer recentf-timer nil 300 'my-recentf-save-list-silently) + ) + +;;; corfu +(my-package corfu + (:install t) + (:delay 5) + (global-corfu-mode 1) + (corfu-popupinfo-mode 1) + (setq corfu-auto t + corfu-cycle t + corfu-separator ?\s) + (define-key corfu-map [remap next-line] nil) + (define-key corfu-map [remap previous-line] nil) + (define-key corfu-map [remap beginning-of-buffer] nil) + (define-key corfu-map [remap end-of-buffer] nil) + (my-keybind corfu-map + "C-j" 'corfu-insert + "<RET>" 'nil + "C-s" #'corfu-next + "C-r" #'corfu-previous) + (require 'my-corfu) + (add-hook 'minibuffer-setup-hook #'my-corfu-enable-always-in-minibuffer 1) + ) + +;;; cape +(my-package cape + (:install t) + (:delay 15) + (setq cape-dabbrev-min-length 3) + (setq cape-symbol-wrapper + '((org-mode ?~ ?~) + (markdown-mode ?` ?`) + (log-edit-mode ?' ?') + (message-mode ?' ?'))) + (dolist (backend '( cape-symbol cape-keyword cape-file cape-history cape-dabbrev)) + (add-to-list 'completion-at-point-functions backend))) + +;;; consult +(my-package consult + (:install t) + (:delay 10) + (setq consult-line-numbers-widen t) + ;; (setq completion-in-region-function #'consult-completion-in-region) + (setq consult-async-min-input 3) + (setq consult-async-input-debounce 0.5) + (setq consult-async-input-throttle 0.8) + (setq consult-narrow-key ">") + (setq register-preview-delay 0.8 + register-preview-function #'consult-register-format) + (setq consult-find-args "find . -not ( -path */.git* -prune )") + (setq consult-preview-key 'any) + (add-to-list 'consult-mode-histories '(vc-git-log-edit-mode . log-edit-comment-ring)) + (add-hook 'completion-list-mode-hook #'consult-preview-at-point-mode) + (require 'consult-imenu) ; the `imenu' extension is in its own file + (require 'my-consult) + (my-keybind global-map + "C-x b" #'consult-buffer + "C-z" #'consult-buffer + "C-x l" #'consult-locate + "M-g M-g" #'consult-goto-line + "M-K" #'consult-keep-lines ; M-S-k is similar to M-S-5 (M-%) + "M-F" #'consult-focus-lines ; same principle + "M-s M-b" #'consult-buffer + "M-s M-f" #'consult-find + "M-s M-G" #'consult-grep + "M-s M-g" #'my-consult-grep-default + "M-s M-h" #'consult-history + "M-s M-i" #'consult-imenu + "M-s M-l" #'consult-line + "M-s M-m" #'consult-mark + "M-y" #'consult-yank-pop + "M-s M-s" #'consult-outline) + (my-keybind consult-narrow-map "?" #'consult-narrow-help) + (my-keybind minibuffer-local-map "C-s" #'consult-history) + ) + +;;; marginalia +(my-package marginalia + (:install t) + (:delay 10) + (setq marginalia-max-relative-age 0) + (marginalia-mode 1)) + +(setq tempel-path + (locate-user-emacs-file "*tempel-templates")) +(my-package tempel + (:install t) + (:delay 15) + (require 'my-tempel) + (my-keybind global-map + "M-=" #'tempel-complete ; Alternative: `tempel-expand' + "M-*" #'tempel-insert) + (my-keybind tempel-map + "RET" #'tempel-done + "C-p" #'tempel-previous + "C-n" #'tempel-next + "<tab>" #'tempel-next + "<backtab>" #'tempel-previous + "C-S-<iso-lefttab>" #'tempel-previous) + (require 'my-tempel) + (dolist (hook '(prog-mode-hook text-mode-hook)) + (add-hook hook 'my-tempel-setup-capf)) + ) + +;; consult-recoll +(my-package consult-recoll + (:delay 30) + (:install t) + ) + +(my-package hmm + (:delay 60) + (my-setq-from-local hmm-web-search-engines) + (require 'my-net) + (setq hmm-web-browsers + '((:name eww :command eww) + (:name luwak :command luwak-open) + (:name firefox :command browse-url-firefox) + (:name firefox-private :command my-browse-url-firefox-private) + (:name tor-browser :command my-browse-url-tor-browser) + (:name download-and-open :command my-fetch-url))) + (setq hmm-handlers + '(:query + ((:command servall-ytdl-search) + (:command servall-wikipedia-open) + (:command servall-wikipedia-search) + (:command hcel-global-ids) + (:command osm-search) + (:command my-org-recoll-mdn) + (:command consult-recoll) + (:command locate) + (:command project-or-external-find-regexp) + (:command dictionary-search) + (:command my-libgen-search) + (:command my-libgen-search-isbn) + (:command my-openlibrary-search) + ;; TODO: sx, grep-somewhere, grep-here, gnus news, gnus email + ;; rt-liber (some sort of smart search) + ) + + ;; URL handlers handle all schemes, including file: + ;; We want to add all file-handlers here with regex that filters + ;; file: in scheme + :url + ((:schemes ("http" "https") + :regex "^en.wikipedia.org/wiki/.*$" + :command servall-wikipedia-open) + (:schemes ("http" "https") + :regex + "^\\(?:.*\\.\\)?\\(?:stackexchange\\|stackoverflow\\|mathoverflow\\|askubuntu\\)\\.com/.*$" + :command sx-open-link) + (:schemes ("http" "https") + :regex + "^\\(?:.*\\.\\)?news.ycombinator.com/.*$" + :command hnreader-comment) + (:schemes ("http" "https") + :command my-org-grok) + (:schemes ("mailto") :command browse-url-mail) + (:schemes ("mailto") :command my-gnus-fastmail-mail-url) + (:schemes ("http" "https") :command my-ytdl-audio) + (:schemes ("http" "https") :command my-ytdl-video) + (:schemes ("http" "https") :command my-describe-package-from-url + :regex + "^\\(?:elpa.gnu.org/packages\\|elpa.gnu.org/devel\\|elpa.nongnu.org/nongnu\\)\\(?:/.*\\).html") + (:command emms-play-url + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + ) ;;FIXME: buggy + ;; TODO: magit-clone-shallow, osm + ) + + :file + ;; by mimetypes / extensions etc, most can be handled by find-file? + ;; shell can be used for dir + ((:command find-file) + (:command dired :mimetypes ("inode/directory")) + (:command my-shell-with-directory :mimetypes ("inode/directory")) + (:command magit-status :mimetypes ("inode/directory")) + (:command byte-compile-file :mimetypes ("text/x-lisp")) + (:command hmm-file-mime-type)))) + (setq hmm-external-handlers + '((:name mpv + :external-command "mpv %U" + :display-name "mpv player" + :description "Play url with mpv" + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + :handling :url) + (:name wget + :external-command "wget %U" + :display-name "GNU Wget" + :description "The non-interactive network downloader" + :schemes + ("ftp" "http" "https") + :handling :url) + (:name qutebrowser + :external-command "qutebrowser %U" + :display-name "qutebrowser" + :description "A keyboard-driven, vim-like browser based on PyQt5" + :schemes + ("http" "https") + :handling :url) + (:name torsocks-mpv + :external-command "torsocks mpv %U" + :display-name "mpv player torsocks" + :description "Play url with mpv over torsocks" + :schemes + ("ftp" "http" "https" "mms" "rtmp" "rtsp" "sftp" "smb" "srt") + :handling :url) + (:name clean-elc-compile + :external-command "clean-elc-compile %f" + :description "Clean compile a directory of elisp files" + :display-buffer t + :mimetypes ("inode/directory") + :handling :file) + (:name mogrify-strip + :external-command "mogrify -strip %F" + :description "Strip images of all profiles and comments" + :display-buffer t + :handling :file) + (:name pacfind + :external-command "pacfind %f" + :description "Find the pacman package containing a command" + :display-buffer t + :handling :query))) + (setq hmm-matchers + '(((thing-at-point-url-at-point) . hmm-url) + ((thing-at-point-file-at-point) . hmm-file) + ((and (derived-mode-p 'dired-mode) (dired-get-filename nil t)) + . hmm-file) + ((and (derived-mode-p 'dired-mode) (expand-file-name default-directory)) + . hmm-file) + ((and (derived-mode-p 'org-mode) (my-org-link-at-point)) . hmm-url) + ((get-text-property (point) 'shr-url) . hmm-url) + ((and (derived-mode-p 'luwak-mode) + (get-text-property (point) 'url)) + . hmm-url) + ((and (derived-mode-p 'luwak-mode) + (plist-get luwak-data :url)) + . hmm-url) + ((thing-at-point 'symbol) . hmm-query) + ((buffer-file-name) . hmm-file) + ((expand-file-name default-directory) . hmm-file))) + (hmm-update)) + +(provide 'ycp-complete) diff --git a/emacs/.emacs.d/init/ycp-dired.el b/emacs/.emacs.d/init/ycp-dired.el new file mode 100644 index 0000000..e8a10ae --- /dev/null +++ b/emacs/.emacs.d/init/ycp-dired.el @@ -0,0 +1,118 @@ +;;; ycp-dired.el -- My config for dired and friends -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for dired and friends. + +;;; Code: + + +(setq delete-by-moving-to-trash 'always) + +(my-package dired + (:delay 5) + (put 'dired-find-alternate-file 'disabled nil) + (setq dired-dwim-target t) + (setq dired-recursive-copies 'always) + (setq dired-recursive-deletes 'always) + (setq dired-listing-switches "-alh") + (add-hook 'dired-mode-hook (lambda () (interactive) + (auto-revert-mode t))) + (add-hook 'dired-mode-hook #'hl-line-mode) + (setq dired-listing-switches "-al --block-size='1") + (my-keybind dired-mode-map + "^" (lambda () (interactive) (find-alternate-file ".."))) + (my-keybind global-map + "C-x C-j" #'dired-jump + ;; to open a dir in dired, find-file is more than sufficient + "C-x d" #'dired-jump) + ) + +(my-package my-dired + (:delay 5) + (my-keybind dired-mode-map + "a" #'my-dired-find-or-alternate + "<return>" #'my-dired-find-or-alternate + "r" #'my-dired-do-rename-and-symlink-back + "s" #'my-dired-toggle-sorting) + ) + +;;; dired-aux +(my-package dired-aux + (:delay 5) + (setq dired-isearch-filenames 'dwim) + (setq dired-create-destination-dirs 'ask) ; Emacs 27 + (setq dired-vc-rename-file t) ; Emacs 27 + (setq dired-do-revert-buffer (lambda (dir) (not (file-remote-p dir)))) + (my-keybind dired-mode-map + "C-+" #'dired-create-empty-file + ;; "M-s f" #'nil + "C-x v v" #'dired-vc-next-action) + ) ; Emacs 28 + + +;;; dired-x +(my-package dired-x + (:delay 5) + (add-hook 'dired-mode-hook #'dired-omit-mode) + (setq dired-omit-files "\\`[.]?#") + (setq dired-clean-up-buffers-too t) + (setq dired-clean-confirm-killing-deleted-buffers t) + (setq dired-x-hands-off-my-keys t) ; easier to show the keys I use + (setq dired-bind-man nil) + (setq dired-bind-info nil) + (my-keybind dired-mode-map "I" #'dired-info)) + +;;; required by dired-subtree +(my-package dash + (:delay 5) + (:install t)) + +(my-package dired-subtree + (:delay 5) + (setq dired-subtree-use-backgrounds nil) + (my-keybind dired-mode-map + "<tab>" #'dired-subtree-toggle + "<backtab>" #'dired-subtree-remove)) + +;;; image-dired +(my-package image-dired + (:delay 10) + (setq image-dired-thumbnail-storage 'standard) + (setq image-dired-external-viewer "xdg-open") + (setq image-dired-thumb-size 80) + (setq image-dired-thumb-margin 2) + (setq image-dired-thumb-relief 0) + (setq image-dired-thumbs-per-row 4) + (my-keybind image-dired-thumbnail-mode-map + "<return>" #'image-dired-thumbnail-display-external)) + + +;;; dired-du +(my-package dired-du + (require 'dired-du) + (setq dired-du-size-format 'comma)) + +(provide 'ycp-dired) diff --git a/emacs/.emacs.d/init/ycp-editing.el b/emacs/.emacs.d/init/ycp-editing.el new file mode 100644 index 0000000..e9c7e4c --- /dev/null +++ b/emacs/.emacs.d/init/ycp-editing.el @@ -0,0 +1,116 @@ +;;; ycp-editing.el -- My config for editing -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for editing. + +;;; Code: + + +;; line wrap at window edge +(set-default 'truncate-lines nil) + +(setq kill-do-not-save-duplicates t) +(setq bidi-inhibit-bpa t) +(setq save-interprogram-paste-before-kill t) +(setq kill-ring-max 200) + +(my-package my-editing + (:delay 5) + (my-keybind global-map + "M-k" #'my-kill-line-backward + "M-w" #'my-copy-line-or-region + "C-o" #'my-new-line-above-or-below + "C-<" #'my-escape-url-dwim + "M-'" #'my-insert-pair + "M-\\" #'my-delete-pair-dwim + "M-Z" #'my-zap-back-to-char + "C-x C-t" #'my-transpose-lines + "M-`" #'my-buffer-create-scratch + "C-M-;" #'my-comment-and-copy-selection + "M-Q" #'my-unfill-paragraph + "C-x M-s" #'my-save-without-formatting + "C-x w" #'my-copy-url-at-point + "C-<backspace>" #'my-backward-kill-path-component + "C-w" #'my-kill-region-if-active + "C-c r <SPC>" #'my-replace-leading-space + "C-c r <RET>" #'my-concat-lines + "C-M-y" #'my-yank-primary + "C-a" #'my-beginning-of-line-or-indentation + ) + ) + +(setq viper-mode nil) +(my-package viper + (:delay 60)) + +(define-key global-map [f2] 'revert-buffer) +(define-key global-map (kbd "C-c r r") 'replace-regexp) +(define-key global-map (kbd "C-c r s") 'replace-string) + +(my-keybind global-map + "M-o" #'delete-blank-lines ; alias for C-x C-o + "M-SPC" #'cycle-spacing + "M-z" #'zap-up-to-char ; NOT `zap-to-char' + "<C-M-backspace>" #'backward-kill-sexp + ) + +(my-package pyim + (:delay 30) + (:install t)) + +;;;; Auto revert mode +(setq auto-revert-verbose t) +(global-auto-revert-mode 1) + +;;;; Delete selection +(delete-selection-mode 1) + +;;;; Tabs, indentation, and the TAB key +(setq-default tab-always-indent 'complete + tab-first-completion 'word-or-paren-or-punct ; Emacs 27 + tab-width 2 + indent-tabs-mode nil) + +(define-key global-map [f12] 'display-line-numbers-mode) + +;; show column number +(column-number-mode t) + +(define-key global-map (kbd "C-x F") 'my-sudo-find-file) + +;; find file +(ffap-bindings) + +(put 'narrow-to-region 'disabled nil) + +(setq large-file-warning-threshold 15000000) + +(add-hook 'text-mode-hook #'turn-on-auto-fill) +(add-to-list + 'auto-mode-alist + '("\\(README\\|CHANGELOG\\|COPYING\\|LICENSE\\)\\'" . text-mode)) + +(provide 'ycp-editing) diff --git a/emacs/.emacs.d/init/ycp-emms.el b/emacs/.emacs.d/init/ycp-emms.el new file mode 100644 index 0000000..d83b53b --- /dev/null +++ b/emacs/.emacs.d/init/ycp-emms.el @@ -0,0 +1,99 @@ +;;; ycp-emms.el -- My configs for multimedia -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My configs for multimedia. + +;;; Code: + +;;; emms is only loaded when `my-profile' is emms, see early-init.el +(my-package emms + (:install t) + (require 'emms-setup) + ;; FIXME: only enable what i use + (emms-all) + (setq emms-playing-time-resume-from-last-played t) + (add-to-list 'emms-info-functions 'emms-info-ytdl) + ;; 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-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) + (add-hook 'emms-playlist-mode-hook #'hl-line-mode) + (add-hook 'emms-metaplaylist-mode-hook #'hl-line-mode) + ) + +(my-package my-emms + (my-setq-from-local my-emms-playlist-alist) + (my-keybind global-map + "C-c s t" #'my-emms-mpv-toggle-torsocks + "C-c s SPC" #'my-emms-switch-to-playlist-buffer + "C-c s v" #'my-emms-mpv-toggle-video + "<XF86AudioPause>" #'emms-pause + "<XF86AudioPlay>" #'emms-pause + "<XF86AudioNext>" #'emms-next + "<XF86AudioPrev>" #'emms-seek-backward + "C-c s a" #'emms-add-all + "C-c s s" #'emms + "C-c s S" #'my-emms-save-all + "C-c s e" #'emms-metaplaylist-mode-go + "C-c s m" #'emms-mode-line-toggle + "C-c s n" #'emms-next + "C-c s r" #'emms-random + "C-c s p" #'my-emms-print-current-track-display-name + "C-c s f" #'my-emms-append-current-track-to-favourites + "C-c s F" #'emms-append-current-track-name-to-file + "C-c s P" #'emms-pause + "C-c s u" #'emms-add-url + "C-c s o" #'my-emms-add-url-region + "C-c s y" #'my-emms-add-ytdl-playlist + "C-c s w" #'my-emms-kill-current-track-name + ) + (my-keybind emms-playlist-mode-map + "s" #'my-emms-playlist-save-current-buffer + "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 + ) + (add-hook 'emms-player-started-hook 'my-emms-maybe-seek-to-last-played) + (my-override emms-mode-line-enable) + (my-override emms-mode-line-disable) + (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) + (my-keybind dired-mode-map "e" #'my-dired-add-to-emms) + (my-override emms-track-simple-description) + (my-emms-add-all) + ) + +(provide 'ycp-emms) diff --git a/emacs/.emacs.d/init/ycp-fun.el b/emacs/.emacs.d/init/ycp-fun.el new file mode 100644 index 0000000..41dd482 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-fun.el @@ -0,0 +1,35 @@ +;;; ycp-fun.el -- My config for amusement -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for amusement. + +;;; Code: + + + +(my-package meme (:delay 60)) +(my-package slime-volleyball (:delay 60)) + +(provide 'ycp-fun) +;;; ycp-fun.el ends here diff --git a/emacs/.emacs.d/init/ycp-gnus.el b/emacs/.emacs.d/init/ycp-gnus.el new file mode 100644 index 0000000..7a03703 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-gnus.el @@ -0,0 +1,214 @@ +;;; ycp-gnus.el -- My config for email etc -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for email etc. Covers gnus, bbdb, message mode etc. + +;;; Code: + + +(my-setq-from-local user-mail-address user-full-name) +(setq mail-user-agent 'message-user-agent) +(setq auth-sources '("~/.authinfo.gpg")) + +;;;; `mm-encode' +(my-package mm-encode + (setq mm-encrypt-option nil ; use 'guided if you need more control + mm-sign-option nil)) ; same + +;;;; `mml-sec' +(my-package mml-sec + (setq mml-secure-openpgp-encrypt-to-self t + mml-secure-openpgp-sign-with-sender t + mml-secure-smime-encrypt-to-self t + mml-secure-smime-sign-with-sender t)) + +;;;; `message' +(my-package message + (setq mail-user-agent 'message-user-agent + message-elide-ellipsis "\n> [... %l lines elided]\n" + compose-mail-user-agent-warnings nil + message-mail-user-agent t ; use `mail-user-agent' + message-citation-line-function #'message-insert-formatted-citation-line + message-ignored-cited-headers "" ; default is "." for all headers + message-confirm-send nil + message-kill-buffer-on-exit t + message-wide-reply-confirm-recipients t + message-citation-line-format + "On %a %Y-%m-%d %H:%M:%S %z, %N wrote:\n") + (add-hook 'message-setup-hook #'message-sort-headers) + ) + +(my-package smtpmail + (my-setq-from-local smtpmail-default-smtp-server + smtpmail-smtp-server smtpmail-stream-type) + (setq smtpmail-smtp-service 587 + smtpmail-queue-mail nil)) + +;;;; `sendmail' (mail transfer agent) +(setq send-mail-function 'smtpmail-send-it) + +;;; gnus +(my-package gnus + (setq gnus-select-method '(nnnil "")) + (setq gnus-group-line-format "%M%S%p%P%5y:%B%(%G%) +") + (setq gnus-secondary-select-methods + '( + ;; "fastdove" is just a name given to gnus + (nnimap "fastdove" + (nnimap-address "localhost") + (nnimap-stream plain) + (nnimap-server-port "imap")) + )) + (setq gnus-agent t) + (dolist (mode '(gnus-group-mode-hook + gnus-summary-mode-hook + gnus-browse-mode-hook)) + (add-hook mode #'hl-line-mode)) + (require 'my-gnus) + (my-setq-from-local my-gnus-inbox-group + my-gnus-group-alist) + (my-keybind global-map + "C-c n i" #'my-gnus-open-inbox + "C-c n n" #'my-gnus-start + "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) + ) + +(my-configure + (:delay 10) + (org-link-set-parameters "gnus" :follow #'my-org-open-gnus-link)) + +(my-package gnus-dired + (add-hook 'dired-mode-hook #'turn-on-gnus-dired-mode)) + +(my-package gnus-msg + (setq gnus-gcc-mark-as-read t) + (setq gnus-message-replysign t) + (my-setq-from-local gnus-posting-styles) + (my-override mm-display-external) + ) + +;; checking sources +(my-package gnus-start + (setq gnus-check-new-newsgroups 'ask-server) + (setq gnus-read-active-file 'some) + (setq gnus-use-dribble-file t) + (setq gnus-always-read-dribble-file t)) + +(my-package gnus-search + (setq gnus-search-use-parsed-queries t)) + +(my-package gnus-win + (setq gnus-use-full-window nil)) + +(my-package gnus-topic + (require 'my-gnus) + (my-keybind gnus-topic-mode-map + "u" #'my-gnus-topic-up + "<RET>" #'my-gnus-topic-select-group) + ) + +(my-package gnus-group + (require 'my-gnus) + (my-keybind gnus-group-mode-map + "n" #'next-line + "p" #'previous-line + "m" #'my-gnus-group-compose + "M-&" nil + "<RET>" #'my-gnus-topic-select-group) + (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) + ) + +(my-package gnus-sum + (require 'my-gnus) + (setq gnus-ignored-from-addresses user-full-name) + (my-keybind gnus-summary-mode-map + "n" #'my-gnus-summary-next-article-like-mu4e + "p" #'my-gnus-summary-prev-article-like-mu4e + "q" #'my-gnus-summary-exit-like-mu4e + "M-u" nil + "M-&" nil + "m" #'my-gnus-move-article-like-mu4e + "r" #'my-gnus-archive-article-like-mu4e + "d" #'my-gnus-trash-article-like-mu4e + "." #'gnus-summary-show-raw-article) + (setq gnus-sum-thread-tree-root "" + gnus-sum-thread-tree-single-leaf "└>" + gnus-sum-thread-tree-leaf-with-other "├>" + gnus-sum-thread-tree-indent " ") + (setq gnus-summary-line-format "%*%U%R%z %d %(%-20,20f%) %B%S +") + (setq gnus-thread-sort-functions + '(gnus-thread-sort-by-most-recent-date)) + ) + +(my-package nnrss + (:delay 60) + (setq nnrss-use-local t)) + +(my-package gnus-art + (setq gnus-inhibit-images t) + (setq gnus-treat-display-smileys nil) + (setq gnus-article-x-face-too-ugly ".*")) ; all images in headers are outright + ; annoying---disabled! +;; gnus-desktop-notify +(my-package gnus-desktop-notify + (:delay 30) + (gnus-desktop-notify-mode) + (setq gnus-desktop-notify-groups 'gnus-desktop-notify-explicit) + ) + +(my-package gnus-demon + (gnus-demon-add-scanmail)) + +;;; bbdb +(my-package bbdb + (:delay 60) + (bbdb-initialize) + (setq bbdb-mail-user-agent 'gnus-user-agent) + (require 'my-bbdb) + (my-keybind bbdb-mode-map "C-c C-c" #'my-bbdb-done) + (setq bbdb-phone-style nil + bbdb-default-country nil) + (my-override bbdb-read-record) + (my-override bbdb-create) + (my-keybind global-map + "C-c b a" #'my-bbdb-all + "C-c b b" #'bbdb + "C-c b c" #'bbdb-create) + ) + +(my-package bbdb-anniv (:delay 60)) + +;; bbdb-vcard +(my-package bbdb-vcard + (:delay 60) + (bbdb-vcard-default-keybindings) + (my-setq-from-local bbdb-vcard-default-dir)) + +(provide 'ycp-gnus) diff --git a/emacs/.emacs.d/init/ycp-grep.el b/emacs/.emacs.d/init/ycp-grep.el new file mode 100644 index 0000000..715f643 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-grep.el @@ -0,0 +1,125 @@ +;;; ycp-grep.el -- My config for search -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for search. Covers grep, search, isearch, occur, recoll +;; etc. + +;;; Code: + + +;;; `grep' package +(my-package grep + (:delay 10) + (setq grep-command "grep -inRH --color -A1 -B1 -E ") + ;; in the form of (string . position), see docs of read-from-minibuffer + (setq grep-find-command + '("find . -type f -exec grep -inRH --color -A1 -B1 -E \\{\\} +" . 52)) + (grep-apply-setting 'grep-find-template + "find -H <D> <X> -type f <F> -exec grep <C> -n --null -E -A1 -B1 <R> /dev/null \\{\\} +") + (setq grep-files-aliases + '(("all" . "* .*") + ("el" . "*.el") + ("ch" . "*.[ch]") + ("c" . "*.c") + ("cc" . "*.cc *.cxx *.cpp *.C *.CC *.c++") + ("cchh" . "*.cc *.[ch]xx *.[ch]pp *.[CHh] *.CC *.HH *.[ch]++") + ("hh" . "*.hxx *.hpp *.[Hh] *.HH *.h++") + ("h" . "*.h") + ("l" . "[Cc]hange[Ll]og*") + ("m" . "[Mm]akefile*") + ("tex" . "*.tex") + ("texi" . "*.texi") + ("asm" . "*.[sS]") + ("docs" . "*.md *.html *.rst *.org *.txt *.asciidoc *.adoc *.tex *.texi"))) + (my-keybind global-map + "C-c r f" #'grep-find + "C-c r g" #'grep) +) + +(my-package my-grep + (:delay 10) + ;; TODO: do we really need this? + (advice-add 'grep :filter-return #'my-grep-focus-buffer) +) + +(my-package isearch + (:delay 5) + (setq search-whitespace-regexp ".*?" ; one `setq' here to make it obvious they are a bundle + isearch-lax-whitespace t + isearch-regexp-lax-whitespace nil) + (setq isearch-lazy-count t) + (setq lazy-count-prefix-format nil) + (setq lazy-count-suffix-format " (%s/%s)") + (setq isearch-yank-on-move 'shift) + (setq isearch-allow-scroll 'unlimited) + (setq isearch-repeat-on-direction-change t) + (define-key minibuffer-local-isearch-map (kbd "M-/") #'isearch-complete-edit) + (my-keybind isearch-mode-map + "C-g" #'isearch-cancel ; instead of `isearch-abort' + "M-/" #'isearch-complete + "C-o" #'isearch-occur) + (my-keybind global-map + "C-s" 'isearch-forward-regexp + "C-r" 'isearch-backward-regexp) + ) + +(my-package replace + (:delay 5) + (add-hook 'occur-mode-hook #'hl-line-mode) + (my-keybind occur-mode-map "t" #'toggle-truncate-lines) + ) + + +;;; `xref' package +(my-package xref + ;; All those have been changed for Emacs 28 + (setq xref-show-definitions-function #'xref-show-definitions-completing-read) ; for M-. + (setq xref-show-xrefs-function #'xref-show-definitions-buffer) + ) + +;;; wgrep (writable grep) +(my-package wgrep + (:install t) + (:delay 15) + (setq wgrep-auto-save-buffer t) + (setq wgrep-change-readonly-file t) + (my-keybind grep-mode-map + "e" #'wgrep-change-to-wgrep-mode + "C-x C-q" #'wgrep-change-to-wgrep-mode + "C-c C-c" #'wgrep-finish-edit)) + +;;; org-recoll +(my-package org-recoll + (:delay 60) + (my-keybind org-recoll-mode-map + "n" #'org-next-visible-heading + "p" #'org-previous-visible-heading + "f" #'org-recoll-next-page + "b" #'org-recoll-previous-page + "<ret>" #'org-open-at-point + "q" #'quit-window)) + +(provide 'ycp-grep) diff --git a/emacs/.emacs.d/init/ycp-help.el b/emacs/.emacs.d/init/ycp-help.el new file mode 100644 index 0000000..b699be9 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-help.el @@ -0,0 +1,114 @@ +;;; ycp-help.el -- My configs for help -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My configs for help. Covers help, man, woman, eldoc, info etc. + +;;; Code: + + +(my-package help-mode + (my-keybind help-mode-map + "x" #'describe-command + "v" #'describe-variable + "f" #'describe-function) + (setq help-window-select t) + (my-keybind global-map + "C-h h" nil + "C-h K" #'describe-keymap ; overrides `Info-goto-emacs-key-command-node' + "C-h c" #'describe-char ; overrides `describe-key-briefly' + "C-h D" #'shortdoc-display-group + ) + ) + +(my-package info + ;; TODO consider using `Info-additional-directory-list' instead + (add-to-list 'Info-directory-list (locate-user-emacs-file "info"))) + +(my-keybind global-map + "C-h C-f" #'find-function + "C-h C-l" #'find-library + "C-h C-v" #'find-variable + "C-h C-p" #'list-packages) +(my-setq-from-local find-function-C-source-directory) + +(my-package eldoc + (:delay 5) + (setq eldoc-echo-area-prefer-doc-buffer t) + ) + +(my-package man + (:delay 10) + (setq Man-notify-method 'pushy) + (require 'my-buffer) + (add-to-list 'my-buffer-create-functions + '(Man-mode . man))) + +(my-package woman + (:delay 10) + (require 'my-buffer) + (add-to-list 'my-buffer-create-functions + '(woman-mode . woman))) + +(my-package help-at-pt + (setq help-at-pt-timer-delay .2) + (setq help-at-pt-display-when-idle t) + (help-at-pt-set-timer)) + +(my-package my-help + (:delay 10) + (my-keybind global-map + "C-h M" #'my-woman-man + "C-h i" #'my-info-display-manual + "C-h ." #'my-describe-symbol-at-point + "\C-h!" #'my-external-command-open-source) + (my-keybind help-mode-map + "o" #'my-help-goto-symbol + "j" #'my-help-goto-symbol) + ) + +(my-configure + (:delay 10) + (add-to-list 'my-buffer-create-functions '(Info-mode . 'my-info-display-manual))) + +;;;; Tooltips (tooltip-mode) +(my-package tooltip + (:delay 15) + (setq tooltip-delay 0.5 + tooltip-short-delay 0.5 + x-gtk-use-system-tooltips nil + tooltip-frame-parameters + '((name . "tooltip") + (internal-border-width . 6) + (border-width . 0) + (no-special-glyphs . t))) + (autoload #'tooltip-mode "tooltip") + (tooltip-mode 1)) + +(my-package my-utils + (:delay 15) + (my-setq-from-local my-docs-root-dir)) + +(provide 'ycp-help) diff --git a/emacs/.emacs.d/init/ycp-markup.el b/emacs/.emacs.d/init/ycp-markup.el new file mode 100644 index 0000000..c001131 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-markup.el @@ -0,0 +1,97 @@ +;;; ycp-markup.el -- My config for markup formats -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for markup formats. + +;;; Code: + + + +;;; parsing and formatting markup and serialization languages: html, markdown, +;;; xml, yaml, etc. +;;; Some parts adapted from prot-dotfiles +(my-package shr + (:delay 30) + (advice-add 'shr-heading :around #'my-shr-add-id-advice) + (setq shr-use-colors nil) + (setq shr-use-fonts nil) + (setq shr-max-image-proportion 0.6) + (setq shr-image-animate nil) + (setq shr-width fill-column) + (setq shr-max-width fill-column) + (setq shr-discard-aria-hidden t) + (setq shr-cookie-policy nil) + ) + +(my-package tex-mode + (:delay 60) + (setq latex-run-command "pdflatex") + (setq tex-print-file-extension ".pdf")) + +(my-package texinfo + (:delay 60) + (my-keybind texinfo-mode-map "C-c C-c" #'makeinfo-buffer)) + +(my-package yaml-mode + (:delay 60) + (:install t) + (add-to-list 'auto-mode-alist '("\\.yml\\'" . yaml-mode)) + (add-hook 'yaml-mode-hook #'display-line-numbers-mode)) + +;;; markdown +(my-package markdown-mode + (:delay 60) + (my-keybind markdown-mode-map "C-c C-l" 'markdown-insert-link) + (setq markdown-hide-urls t) + (put 'markdown-translate-filename-function 'safe-local-variable 'functionp) + (require 'my-markdown) + (my-keybind markdown-mode-map "<ret>" 'my-markdown-maybe-follow-thing-at-point)) + +;; mediawiki +(my-package mediawiki (:delay 60)) + +(my-package ledger-mode + (:install t) + (:delay 60) + (add-hook 'ledger-mode-hook + (lambda () + (setq-local tab-always-indent 'complete) + (setq-local completion-cycle-threshold t) + (setq-local ledger-complete-in-steps t) + (setq-local company-mode nil))) + (setq ledger-binary-path "hledger")) + +;;; 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) + (add-hook 'nov-mode-hook 'follow-mode) + (require 'my-nov) + (my-override nov-render-title) + (my-override nov-scroll-up) + ) + +(provide 'ycp-markup) +;;; ycp-markup.el ends here diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el new file mode 100644 index 0000000..240cfcf --- /dev/null +++ b/emacs/.emacs.d/init/ycp-org.el @@ -0,0 +1,417 @@ +;; -*- lexical-binding: t; -*- + +;;; the glorious org mode +(my-package org + (my-keybind global-map + "M-u" #'org-store-link + "C-c a" #'org-agenda + "C-c c" #'org-capture + "<f6>" #'my-org-open-default-notes-file + ) + (setq org-startup-folded 'overview) + (my-override org-next-link) + (my-override org-previous-link) + (my-override org--mouse-open-at-point) + (my-keybind org-mode-map + "M-l" #'org-insert-last-stored-link + "M-n" #'org-next-link + "M-p" #'org-previous-link + "C-c C-l" #'org-insert-link + "C-j" #'default-indent-new-line + ) + (my-keybind minibuffer-mode-map "M-l" #'org-insert-last-stored-link) + (my-setq-from-local my-org-common-properties org-directory + my-org-doc-dir) + ;; disable auto-indent on RET + (add-hook 'org-mode-hook (lambda () (electric-indent-local-mode -1))) + ;; disable truncate lines + (add-hook 'org-mode-hook #'toggle-truncate-lines) + ;; disable yas-minor-mode for org + (add-hook 'org-mode-hook (lambda () (yas-minor-mode -1))) + (add-hook 'org-mode-hook (lambda () (setq-local tab-width 2))) + + (setq org-adapt-indentation 'headline-data) + (setq org-special-ctrl-a/e t) + (setq org-special-ctrl-k t) + (setq org-M-RET-may-split-line '((default . nil))) + (setq org-catch-invisible-edits 'show) + (setq org-modules '(ol-bbdb ol-gnus ol-info)) + (setq org-use-sub-superscripts '{}) + (setq org-use-fast-todo-selection 'expert) + (setq org-fontify-quote-and-verse-blocks t) + (setq org-highlight-latex-and-related nil) ; other options affect elisp regexp + ; in src blocks + (setq org-log-done 'time) + (setq org-archive-location "%s_archive::") + (setq org-file-apps + '((auto-mode . emacs) + (directory . emacs) + ("\\.mm\\'" . default) + ("\\.x?html?\\'" . emacs) + ("\\.pdf\\'" . emacs) + ("\\.mp4\\'" . "xdg-open %s"))) + (setq org-structure-template-alist + '(("a" . "export ascii") + ("c" . "center") + ("C" . "comment") + ("e" . "example") + ("E" . "export") + ("h" . "export html") + ("l" . "export latex") + ("m" . "src emacs-lisp") + ("q" . "quote") + ("s" . "src") + ("v" . "verse"))) + (setq org-use-tag-inheritance nil) + (my-setq-from-local org-default-notes-file) + (setq org-export-backends '(ascii beamer html icalendar latex md odt org)) + (setq org-image-actual-width '(400)) + (setq org-log-into-drawer t) + (plist-put org-format-latex-options :scale 1.5) + (setq org-reverse-note-order t) + (add-hook 'before-save-hook #'my-org-update-updated) + ) + +(my-package org-goto + (setq org-goto-interface 'outline-path-completion) + ) + +(my-package org-element + ;; org-persist is buggy with encoding etc. let's disable it + (setq org-element-cache-persistent nil) + ) + +;;; ox - org export +(my-package ox + (:delay 60) + (setq org-export-headline-levels 8) + (require 'ox-html) + (setq org-html-prefer-user-labels t) + (setq org-html-self-link-headlines t) + (require 'ox-icalendar) + (setq org-icalendar-include-bbdb-anniversaries t) + (setq org-icalendar-include-todo t) + (setq org-icalendar-use-scheduled '(event-if-todo todo-start)) + ) + +(my-package org-id + (setq org-id-link-to-org-use-id 'create-if-interactive) + ) + +;;; cite +(my-package oc + (:delay 60) + (my-setq-from-local org-cite-global-bibliography) + ) + +(my-package org-src + (:delay 10) + (setq org-edit-src-persistent-message nil) + (my-keybind org-src-mode-map "C-c C-c" #'org-edit-src-exit) + (setq org-src-window-setup 'current-window) + (setq org-src-preserve-indentation t) ;; useful for yaml and python + ) + +(my-package org-agenda + (:delay 10) + (my-keybind global-map "C-c g" 'my-org-store-agenda-view-A) + (setq org-agenda-confirm-kill t) + (setq org-agenda-follow-indirect t) + (setq org-agenda-time-leading-zero t) + (setq org-agenda-todo-ignore-time-comparison-use-seconds t) + (setq org-agenda-todo-ignore-deadlines 'all) + (setq org-agenda-todo-ignore-scheduled 'all) + (setq org-agenda-todo-ignore-with-date 'all) + (setq org-agenda-todo-ignore-timestamp 'all) + (setq org-agenda-tags-todo-honor-ignore-options t) + (setq org-agenda-dim-blocked-tasks nil) + (setq org-agenda-sticky t) + (setq org-agenda-inhibit-startup t) + (my-setq-from-local org-agenda-files) + (setq org-agenda-skip-deadline-if-done nil) + (setq org-agenda-skip-scheduled-if-done nil) + (setq org-agenda-skip-timestamp-if-done t) + (setq org-agenda-start-on-weekday 6) + (setq org-agenda-custom-commands + `(("A" "Agenda and next" + ((agenda "" + ((org-agenda-span 'week))) + (tags-todo "PRIORITY=\"A\"" nil)) + nil + ,(my-get-from-local my-org-agenda-and-next-export-files)) + ("B" "Agenda and context" + ((agenda "" ((org-agenda-span 'week))) + (tags-todo "{^@.*}")) + nil) + ("@" "context todos" + ((tags-todo "{^@.*}")) + nil))) + (setq org-agenda-prefix-format + '((agenda . "%-5:c%?-12t% s") + (todo . "%-4:c") + (tags . "%-4:c") + (search . "%-4:c"))) + (setq org-agenda-use-tag-inheritance nil) + (add-hook 'org-agenda-mode-hook #'hl-line-mode) + (add-hook 'org-agenda-after-show-hook 'my-org-agenda-after-show) + (org-defkey org-agenda-mode-map "d" #'org-agenda-deadline) + (org-defkey org-agenda-mode-map "s" #'org-agenda-schedule) + (setq org-agenda-window-setup 'other-window) + ) + +(my-package ob-core + (setq org-babel-load-languages '((emacs-lisp . t) (shell . t))) + (setq org-confirm-babel-evaluate nil) + ) + +(my-package org-capture + (setq org-capture-templates + `(("j" "Journal" entry + (file+olp+datetree ,(my-get-from-local my-org-journal-file)) + "* %^{Title} +:PROPERTIES: +:CREATED: %U +:END: + +%?") + ("t" "Todo" entry + (file+headline org-default-notes-file "Inbox") + "* TODO %a%? +:PROPERTIES: +:CREATED: %U +:END: + +%i" + :prepend t) + ("ya" "Blank audio" entry + (file+headline org-default-notes-file "Audios") + nil + :prepend t) + ("book" "Blank books and papers" entry + (file+headline org-default-notes-file "Books and papers") + nil + :prepend t) + ("video" "Blank videos" entry + (file+headline org-default-notes-file "Videos") + nil + :prepend t) + ("entity" "Blank entities" entry + (file+headline org-default-notes-file "Entities") + nil + :prepend t) + ("videogame" "Blank video games" entry + (file+headline org-default-notes-file "Video games") + nil + :prepend t) + ("software" "Blank software" entry + (file+headline org-default-notes-file "Software") + nil + :prepend t) + ("organisation" "Blank organisation" entry + (file+headline org-default-notes-file "Organisations") + nil + :prepend t) + ("people" "Blank people" entry + (file+headline org-default-notes-file "People") + nil + :prepend t) + ("game" "Blank games" entry + (file+headline org-default-notes-file "Games") + nil + :prepend t) + ("location" "Blank location" entry + (file+headline org-default-notes-file "Locations") + nil + :prepend t)))) + +(my-package org-clock + (setq org-clock-history-length 100) + (setq org-clock-in-switch-to-state "DOIN") + (setq org-clock-idle-time 10) + (setq org-clock-mode-line-total 'auto) + (setq org-clock-persist 'history) + (org-clock-persistence-insinuate)) + +(my-package org-refile + (setq org-outline-path-complete-in-steps nil) + (setq org-refile-allow-creating-parent-nodes 'confirm) + (setq org-refile-targets '((org-agenda-files :maxlevel . 5))) + (setq org-refile-use-cache t) + (setq org-refile-use-outline-path t) + ) + +;;; todo: some of these commands will take a while to be ready +(my-package org-keys + (setq org-return-follows-link t) + (setq org-use-speed-commands t) + (setq org-speed-commands + '(("User commands") + ("m" . my-magit-clone-org-source) + ("c" . my-org-copy-property-value) + ("x" . my-org-osm-goto) + ("X" . my-osm-org-add-properties) + ("y" . my-grok-update-properties) + ("z" . my-org-orgzly-merge-link) + ("A" . org-attach) + ("P" . my-org-set-common-property) + ("N" . my-org-jump-to-last-visible-child) + ("d" . org-deadline) + ("s" . org-schedule) + ("S" . org-toggle-narrow-to-subtree) + (";" . org-timer-set-timer) + ("," . org-timer-pause-or-continue) + ("h" . my-org-entry-toggle-drawer-visibility) + ("Outline Navigation") + ("n" org-speed-move-safe 'org-next-visible-heading) + ("p" org-speed-move-safe 'org-previous-visible-heading) + ("f" org-speed-move-safe 'org-forward-heading-same-level) + ("b" org-speed-move-safe 'org-backward-heading-same-level) + ("F" . org-next-block) + ("B" . org-previous-block) + ("u" org-speed-move-safe 'outline-up-heading) + ("j" . org-goto) + ("g" org-refile + '(4)) + ("Outline Visibility") + ("C" . org-shifttab) + (" " . org-display-outline-path) + ("s" . org-toggle-narrow-to-subtree) + ("k" . org-cut-subtree) + ("=" . org-columns) + ("Outline Structure Editing") + ("U" . org-metaup) + ("D" . org-metadown) + ("r" . org-metaright) + ("l" . org-metaleft) + ("R" . org-shiftmetaright) + ("L" . org-shiftmetaleft) + ("i" . my-org-append-subheading) + ("^" . org-sort) + ("w" . org-refile) + ("a" . org-archive-subtree-default-with-confirmation) + ("@" . org-mark-subtree) + ("#" . org-toggle-comment) + ("Clock Commands") + ("I" . org-clock-in) + ("O" . org-clock-out) + ("Meta Data Editing") + ("t" . org-todo) + ("," org-priority) + ("0" org-priority 32) + ("1" org-priority 65) + ("2" org-priority 66) + ("3" org-priority 67) + (":" . org-set-tags-command) + ("e" . org-set-effort) + ("E" . org-inc-effort) + ("W" lambda + (m) + (interactive "sMinutes before warning: ") + (org-entry-put + (point) + "APPT_WARNTIME" m)) + ("Agenda Views etc") + ("v" . org-agenda) + ("/" . org-sparse-tree) + ("Misc") + ("o" . org-open-at-point) + ("?" . org-speed-command-help) + ("<" org-agenda-set-restriction-lock 'subtree) + (">" org-agenda-remove-restriction-lock))) + ) + +;;;; +;; org attach +;;;; +(my-package org-attach + (:delay 15) + (setq org-attach-store-link-p 'attached) + (require 'my-org) + (my-setq-from-local my-org-attach-copy-attached-targets) + (add-to-list 'org-attach-commands '((?k) my-org-attach-copy-attached-docs + "Copy attached docs.")) + (require 'my-scihub) + (add-to-list 'org-attach-commands '((?p) my-org-attach-scihub + "Download document from scihub.")) + (require 'my-calibre) + (add-to-list 'org-attach-commands '((?C) org-attach-calibre-book + "Attach from local calibre libray.")) + (add-to-list 'org-attach-commands '((?V) my-org-attach-all-url-plaintext + "Fetch all urls to plaintext file")) + (my-override org-attach-url) + (add-to-list 'org-attach-commands '((?U) my-org-attach-url-plaintext + "Fetch url to plaintext file")) + (add-to-list 'org-attach-commands '((?A) my-org-attach-url-plaintext-all-media + "Fetch url to plaintext file, and all media + files therein.")) + ) + +;; org-protocol +(my-package org-protocol + (:delay 30) + (require 'my-org) + (add-to-list 'org-protocol-protocol-alist + '("grok" + :protocol "grok" + :function my-org-protocol-grok))) + +;; org man links +(my-package ol-man + (:delay 30) + (setq org-man-command 'woman)) + +(my-package ol + (:delay 10) + (require 'my-buffer) + (add-to-list 'org-link-frame-setup + (cons 'file 'my-find-file-maybe-other-window))) + +(my-package my-org + (:delay 10) + (my-keybind org-mode-map + "C-c 1" #'my-org-insert-date-range + "C-c ns" #'my-org-substitute-gnus-link-after-archiving + "C-x w" #'my-org-copy-link-at-point + "C-'" #'my-org-store-link-and-return + "C-c M-w" #'my-org-copy-dwim + "C-c <f7>" #'my-org-open-shell-at-attach-dir + "C-M-n" #'my-org-next-block-or-results + "C-M-p" #'my-org-previous-block-or-results) + (add-hook 'org-follow-link-hook 'my-org-follow-link-after) + (my-override org-insert-all-links) + (my-override org-open-at-point-global) + (my-override org-refile-get-targets) + (my-override org-insert-last-stored-link) + (org-link-set-parameters "info" :follow #'my-org-info-open-new-window) + (org-link-set-parameters "rt" :follow #'my-org-rt-open-new-window) + (my-override org-src--make-source-overlay) + (my-server-timer my-org-clock-save-timer + nil 600 'my-org-clock-maybe-save) + (my-server-idle-timer my-org-refile-rebuild-cache-timer + 600 t 'my-org-refile-cache-rebuild) + (my-server-idle-timer my-org-agenda-redo-all-timer + 660 t 'my-org-agenda-redo-all) + (org-defkey org-agenda-mode-map "0" #'my-org-agenda-priority-0) + (org-defkey org-agenda-mode-map "1" #'my-org-agenda-priority-A) + (org-defkey org-agenda-mode-map "2" #'my-org-agenda-priority-B) + (org-defkey org-agenda-mode-map "3" #'my-org-agenda-priority-C) + (with-eval-after-load "org-capture" + (advice-add 'org-capture-place-template + :around 'my-org-capture-place-template-dont-delete-windows)) + ) + +(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))) + (require 'eww) + (define-key eww-mode-map (kbd "C-'") 'my-eww-org-protocol-grok) + ) + +(provide 'ycp-org) +;;; ycp-org.el ends here diff --git a/emacs/.emacs.d/init/ycp-package.el b/emacs/.emacs.d/init/ycp-package.el new file mode 100644 index 0000000..bdf24f7 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-package.el @@ -0,0 +1,70 @@ +;;; ycp-package.el -- My configs for package -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My configs for package. This should be the second require in the +;; init file after my-package. + +;;; Code: + + + +;; TODO: The use of `my-allowed-package' may necessitate some refactoring to +;; hide configs under an (my-package dummy) +(cond + ((equal my-profile "emms") + (setq my-allowed-packages '(package windmove emms my-emms))) + ((equal my-profile "erc") + (setq my-allowed-packages '(package windmove icomplete modus-themes erc))) + (t + (setq my-omit-packages + '(typescript-mode tide web-mode flycheck ggtags crystal-mode + proof-general sml-mode emms my-emms erc)))) + +(my-read-local-config) +;; only start server on default profile +(unless my-profile (server-start)) + +;;; packages; customization +(my-package package + (setq package-archives + '(("gnu" . "https://elpa.gnu.org/packages/") + ("elpa-devel" . "https://elpa.gnu.org/devel/") + ("nongnu" . "https://elpa.nongnu.org/nongnu/"))) + (setq package-archive-priorities + '(("gnu" . 3) + ("nongnu" . 2) + ("elpa-deval" . 1))) + (setq package-pinned-packages + '((hcel . "elpa-devel") + (luwak . "elpa-devel"))) + (add-hook 'package-menu-mode-hook #'hl-line-mode) +) + +(my-package cus-edit + (my-keybind global-map + "C-c u u" #'customize + "C-c u g" #'customize-group + "C-c u o" #'customize-option)) + +(provide 'ycp-package) diff --git a/emacs/.emacs.d/init/ycp-pdf.el b/emacs/.emacs.d/init/ycp-pdf.el new file mode 100644 index 0000000..d90a527 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-pdf.el @@ -0,0 +1,60 @@ +;;; ycp-pdf.el -- My config for non-markup doc formats -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for non-markup doc formats. Covers pdf, docx etc. + +;;; Code: + + + +(my-package pdf-tools + (:install t) + (:delay 15) + (pdf-loader-install)) + +(my-package pdf-history + (:delay 15) + (my-keybind pdf-history-minor-mode-map + "l" #'pdf-history-backward + "r" #'pdf-history-forward + "N" nil + "P" nil) + ) + +(my-package my-pdf-tools + (:delay 15) + (my-keybind pdf-view-mode-map + "i" #'my-pdf-outline-jump + "]" #'my-pdf-view-forward-node + "N" #'my-pdf-view-forward-node-same-depth + "[" #'my-pdf-view-backward-node + "P" #'my-pdf-view-backward-node-same-depth + "U" #'my-pdf-view-backward-node-lower-depth + "." #'my-pdf-view-enlarge-a-bit + "," #'my-pdf-view-shrink-a-bit) + ) + +(provide 'ycp-pdf) +;;; ycp-pdf.el ends here + diff --git a/emacs/.emacs.d/init/ycp-prog.el b/emacs/.emacs.d/init/ycp-prog.el new file mode 100644 index 0000000..9ab868b --- /dev/null +++ b/emacs/.emacs.d/init/ycp-prog.el @@ -0,0 +1,373 @@ +;;; ycp-prog.el -- My config for programming -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for programming. Covers comint, shell, eshell, compile, +;; xref, eglot, prog-mode etc. + +;;; Code: + + + +;;; comint, shell, eshell +(my-package comint + (setq ansi-color-for-comint-mode t) + (setq-default comint-scroll-to-bottom-on-input t) + (setq-default comint-scroll-to-bottom-on-output nil) + (setq-default comint-input-autoexpand 'input) + (setq comint-prompt-read-only t) + (setq comint-buffer-maximum-size 9999) + (setq comint-completion-autolist t) + (define-key comint-mode-map (kbd "C-<up>") 'windmove-up) + (define-key comint-mode-map (kbd "C-<down>") 'windmove-down) + (setq comint-input-ring-size 5000) + (setq comint-input-ignoredups t) + (setq comint-terminfo-terminal "dumb") + (setq comint-password-prompt-regexp + (concat comint-password-prompt-regexp + "\\|^BECOME password:\\s *\\'" + "\\|^SSH password:\\s *\\'")) + ) + +(my-package shell + (:delay 5) + (setq shell-command-prompt-show-cwd t) + (setq shell-input-autoexpand 'input) + + (my-keybind shell-mode-map + "<up>" #'comint-previous-input + "<down>" #'comint-next-input + "C-c C-k" #'comint-clear-buffer + "C-c C-w" #'comint-write-output) + (setq shell-command-prompt-show-cwd t) + (add-hook 'shell-mode-hook + (lambda () + (setq comint-input-ring-file-name "~/.bash_history"))) + (add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on) + ) + +(my-package sh-script + (:delay 5) + (setq sh-basic-offset 2) + (add-to-list 'auto-mode-alist '("PKGBUILD" . sh-mode)) +) + +(my-package my-prog + (:delay 10) + ;; tab-width 8 for ls etc. + (add-hook 'shell-mode-hook 'my-set-tab-width-to-8) + (my-keybind comint-mode-map "C-<return>" + #'my-comint-send-input-and-return-prompt) + (add-to-list 'my-buffer-create-functions + '(shell-mode . my-shell-with-directory)) + (my-keybind shell-mode-map "<f2>" #'my-restart-shell) + (add-hook 'shell-mode-hook 'my-shell-disable-company-if-remote) + ) + +(my-package eshell + (:delay 60) + (setq eshell-modules-list + '(eshell-alias eshell-banner eshell-basic eshell-cmpl eshell-dirs eshell-glob eshell-hist eshell-ls eshell-pred eshell-prompt eshell-script eshell-term eshell-tramp eshell-unix)) + ) + +(my-package bash-completion + (:install t) + (:delay 15)) + +;;; prog modes: c, c++, elisp, js, css, ts, +(my-package prog-mode + (add-hook 'prog-mode-hook #'display-line-numbers-mode) + (add-hook 'prog-mode-hook (lambda () (setq-local tab-width 2)))) + +;; cmake +(my-package cmake-mode + (:delay 60)) + +;;; eglot +(my-package eglot + (:delay 10) + (add-to-list 'eglot-server-programs + '((php-mode phps-mode) + "phpactor" "language-server" "-vvv")) + (add-hook 'before-save-hook (lambda () (interactive) + (when (eglot-managed-p) + (unless (eq major-mode 'haskell-mode) + (eglot-format-buffer))))) + (setq-default eglot-workspace-configuration + '((:pylsp + (plugins + (pylint + (enabled . t) + (executable . "/usr/bin/pylint")))) + (:haskell-language-server + (haskell + (formattingProvider . :json-false))))) + (add-to-list 'eglot-server-programs + '(haskell-mode + "haskell-language-server-wrapper" "--lsp" "--debug")) + + ;; I'm not sure why this is needed, but it throws an error if I remove it + (cl-defmethod project-root ((project (head eglot-project))) + (cdr project)) + + (defun my-project-try-tsconfig-json (dir) + (when-let* ((found (locate-dominating-file dir "tsconfig.json"))) + (cons 'eglot-project found))) + + (add-hook 'project-find-functions + 'my-project-try-tsconfig-json nil nil) + + (add-to-list 'eglot-server-programs + '((typescript-mode) "typescript-language-server" "--stdio"))) + +(my-package cc-mode + (:delay 5) + (define-key c-mode-map (kbd "C-c C-c") 'compile) + ) + +(my-package my-prog + (:delay 10) + (add-hook 'c-mode-hook 'my-c-set-compile-command) + (my-keybind global-map "C-c 8" #'my-set-tab-width-to-8) + ) + +;;; emacs-lisp mode +(my-package elisp-mode + (my-keybind emacs-lisp-mode-map "C-c C-c" #'eval-buffer) + (add-hook 'emacs-lisp-mode-hook (lambda () (auto-fill-mode 1))) + (setq print-length 1000) + (my-keybind global-map + "<f5>" #'my-toggle-debug-on-error-quit + "C-c e e" (lambda () (interactive) + (find-file (locate-user-emacs-file "init.el"))) + "C-c e d" (lambda () (interactive) + (find-file (locate-user-emacs-file "init"))) + "C-c e m" (lambda () (interactive) + (find-file (locate-user-emacs-file "lisp/my"))) + "C-c e b" (lambda () (interactive) + (my-switch-to-buffer-matching-major-mode + 'emacs-lisp-mode))) + ;; for deep recursion, e.g. in radix tree + (setq max-specpdl-size 32000) + ) + +;;; paredit +(my-package paredit + (:install t) + (add-hook 'emacs-lisp-mode-hook #'enable-paredit-mode) + (add-hook 'eval-expression-minibuffer-setup-hook #'enable-paredit-mode) + (add-hook 'ielm-mode-hook #'enable-paredit-mode) + (add-hook 'lisp-mode-hook #'enable-paredit-mode) + (add-hook 'lisp-data-mode-hook #'enable-paredit-mode) + (add-hook 'lisp-interaction-mode-hook #'enable-paredit-mode) + (add-hook 'scheme-mode-hook #'enable-paredit-mode) + (my-keybind paredit-mode-map + "M-<left>" #'paredit-forward-barf-sexp + "M-<right>" #'paredit-forward-slurp-sexp + "C-<left>" nil + "C-<right>" nil + "M-?" nil + "C-j" nil ;not ideal, we just want to unshadow it in lisp-interaction-mode + "<RET>" #'paredit-newline + "M-s" nil + "M-o" #'paredit-splice-sexp + "M-h" #'paredit-convolute-sexp) + ) + +;;; flymake +(my-package flymake + (:install t) + (:delay 15) + (my-keybind flymake-mode-map + "M-n" #'flymake-goto-next-error + "M-p" #'flymake-goto-prev-error)) + +(my-package my-prog + (require 'xref) + (my-override xref-query-replace-in-results)) + +(my-package js + (:delay 60) + (setq js-indent-level 2) + (add-hook 'js-mode-hook 'subword-mode) + (my-keybind js-mode-map "M-." #'xref-find-definitions) + ) + +(my-package typescript-mode + (:delay 60) + (:install t) + (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode)) + (setq typescript-indent-level 2) + ) + +(my-package tide + (:delay 60) + (require 'my-tide) + ;; aligns annotation to the right hand side + (setq company-tooltip-align-annotations t) + + ;; formats the buffer before saving + (add-hook 'before-save-hook 'tide-format-before-save) + + (add-hook 'typescript-mode-hook #'setup-tide-mode) + (add-hook 'typescript-mode-hook 'subword-mode) + ) + +(my-package web-mode + (:delay 60) + (:install t) + (add-to-list 'auto-mode-alist '("\\.tsx\\'" . web-mode)) + (add-to-list 'auto-mode-alist '("\\.jsx\\'" . web-mode)) + (setq web-mode-content-types-alist '(("jsx" . "\\.js[x]?\\'"))) + (setq web-mode-markup-indent-offset 2) + (setq web-mode-code-indent-offset 2) + (add-hook 'web-mode-hook + (lambda () + (when (string-equal "tsx" (file-name-extension buffer-file-name)) + (my-setup-tide-mode)))) + ) + +(my-package flycheck + (:delay 60) + (flycheck-add-mode 'typescript-tslint 'web-mode) + ) + +(my-package css-mode + (setq css-indent-offset 2)) + +(my-package haskell-mode + (:install t) + (:delay 60) + ;; do we need to require haskell-command? + (setq haskell-compile-command + "ghc -Wall -ferror-spans -fforce-recomp -dynamic -c %s") + (my-keybind haskell-mode-map "C-c C-c" #'haskell-compile) + (setq haskell-mode-stylish-haskell-path "brittany") + (setq haskell-stylish-on-save t) + (my-setq-from-local haskell-hoogle-url) + (add-hook 'haskell-mode-hook 'subword-mode) + (add-hook 'haskell-mode-hook 'interactive-haskell-mode) + (add-hook 'haskell-mode-hook + (lambda () + (set (make-local-variable 'company-backends) + (append '((company-capf company-dabbrev-code)) + company-backends)))) + (setq haskell-interactive-popup-errors t) + (setq haskell-process-suggest-hoogle-imports t) + (setq haskell-process-log t) + (cl-pushnew '(haskell-process-use-ghci . t) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indent-spaces . 4) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-tags-on-save . t) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-where-post-offset . 2) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-where-pre-offset . 2) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-ifte-offset . 4) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-left-offset . 4) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-starter-offset . 1) + safe-local-variable-values :test #'equal) + (cl-pushnew '(haskell-indentation-layout-offset . 4) + safe-local-variable-values :test #'equal)) + +(my-package hcel + ;; fixme: credential + (:delay 60) + (:install t) + ;; The official one is https://haskell-code-explorer.mfix.io + (my-setq-from-local hcel-host) + (my-keybind global-map + "C-c hh" #'hcel + "C-c hi" #'hcel-global-ids + "C-c ho" #'hcel-help) + ) + +(my-package hcel-haddorg + (:delay 60) + ;; fixme: credential + (my-setq-from-local hcel-haddorg-dir)) + +(my-package ggtags + (:install t) + (:delay 60) + (my-keybind ggtags-navigation-map + ggtags-navigation-map "M-<" nil + ggtags-navigation-map "M->" nil)) + +(my-package phps-mode + (:install t) + (:delay 60) + (add-to-list 'auto-mode-alist '("\\.\\(?:php[s345]?\\|phtml\\)\\'" . phps-mode)) + (add-to-list 'auto-mode-alist '("\\.\\(?:php\\.inc\\|stub\\)\\'" . phps-mode)) + (add-to-list 'auto-mode-alist '("/\\.php_cs\\(?:\\.dist\\)?\\'" . phps-mode)) + (add-hook 'before-save-hook (lambda () (interactive) + (when (eq major-mode 'phps-mode) + (phps-mode-format-buffer))))) + +(my-package crystal-mode + (:delay 60) + (require 'flycheck-crystal)) + +(my-package imenu + (:delay 5) + (my-keybind global-map "C-c i" #'imenu) +) + +;;; proof-general +(my-package proof-general + (:install t) + (:delay 60) + (setq coq-prog-name "/usr/bin/coqtop") + (setq coq-compiler "~/.opam/default/bin/coqc") + (setq coq-prog-env '("PATH=/usr/bin/:$HOME/.opam/default/bin/")) + (setq coq-diffs 'on) + (setq proof-three-window-enable nil)) + +;;; tree-sitter +(add-to-list 'load-path (locate-user-emacs-file "lisp/elisp-tree-sitter/core")) +(add-to-list 'load-path (locate-user-emacs-file "lisp/elisp-tree-sitter/lisp")) +(my-package tree-sitter + (:delay 15) + (require 'tree-sitter-hl) + (require 'tree-sitter-langs) + (require 'tree-sitter-debug) + (require 'tree-sitter-query) + (add-to-list 'tree-sitter-major-mode-language-alist + '(haskell-mode . haskell)) + (add-to-list 'tree-sitter-major-mode-language-alist + '(phps-mode . php)) + (global-tree-sitter-mode) + (add-hook 'tree-sitter-after-on-hook #'tree-sitter-hl-mode)) + +;;; sml +(my-package sml-mode + (:install t) + (:delay 60) + (setq sml-indent-level 2)) + +(provide 'ycp-prog) +;;; ycp-prog.el ends here diff --git a/emacs/.emacs.d/init/ycp-project.el b/emacs/.emacs.d/init/ycp-project.el new file mode 100644 index 0000000..d8c2628 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-project.el @@ -0,0 +1,45 @@ +;;; ycp-project.el -- My config for project -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for project-related functionalities. + +;;; Code: + + +(my-package my-project + (:delay 15) + (my-keybind global-map + "\C-xpl" #'my-project-copy-license-file-to-project + "\C-xpS" #'my-project-shell-at + "\C-xpD" #'my-project-dired-at + "\C-xpR" #'my-project-rgrep-at + "\C-xpC" #'my-project-code-stats) + (my-server-idle-timer + my-project-remember-projects-timer + 300 t + 'my-project-remember-all-projects) + ) + +(provide 'ycp-project) +;;; ycp-project.el ends here diff --git a/emacs/.emacs.d/init/ycp-system.el b/emacs/.emacs.d/init/ycp-system.el new file mode 100644 index 0000000..3d52d34 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-system.el @@ -0,0 +1,85 @@ +;;; ycp-system.el -- My config for things working with the underlying system -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for things working with the underlying system that do not +;; seem to be clients to system utilities. Covers process monitor, +;; tramp etc. + +;;; Code: + + +;;; `proced' (process monitor, similar to `top') +(my-package proced + (:delay 30) + (setq proced-auto-update-flag t) + (setq proced-auto-update-interval 5) + (setq proced-descend t) + (setq proced-filter 'user)) + +;;; `tramp' +(my-package tramp + (:delay 15) + (setq tramp-default-method "ssh") + (setq explicit-shell-file-name "/bin/bash") + (add-to-list 'tramp-remote-path 'tramp-own-remote-path) + + (connection-local-set-profile-variables + 'termux-bash + '((explicit-shell-file-name . "/data/data/com.termux/files/usr/bin/bash") + (shell-file-name . "/data/data/com.termux/files/usr/bin/bash") + (tramp-remote-path . ("/data/data/com.termux/files/usr/bin")))) + (connection-local-set-profiles + `(:application tramp :protocol "ssh" + :machine ,(my-get-from-local my-tramp-termux-machine)) + 'termux-bash) + + (connection-local-set-profile-variables + 'ghcup-bash + '((tramp-remote-path . ("~/.ghcup/bin" "~/.local/bin" tramp-default-remote-path)))) + (connection-local-set-profiles + `(:application tramp :protocol "ssh" + :machine ,(my-get-from-local my-tramp-ghcup-machine)) + 'ghcup-bash) + + (connection-local-set-profile-variables + 'guix-bash + '((explicit-shell-file-name . "/run/current-system/profile/bin/sh") + (shell-file-name . "/run/current-system/profile/bin/sh") + (tramp-remote-path . ("/run/current-system/profile/bin" "/run/current-system/profile/sbin")))) + (connection-local-set-profiles + `(:application tramp :protocol "ssh" + :machine ,(my-get-from-local my-tramp-guix-machine)) + 'guix-bash) + + (connection-local-set-profile-variables + 'adb-shell + '((explicit-shell-file-name . "/system/bin/sh"))) + (connection-local-set-profiles + '(:application tramp :protocol "adb") + 'adb-shell)) + +(provide 'ycp-system) +;;; ycp-system.el ends here diff --git a/emacs/.emacs.d/init/ycp-theme.el b/emacs/.emacs.d/init/ycp-theme.el new file mode 100644 index 0000000..ee76311 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-theme.el @@ -0,0 +1,46 @@ +;;; ycp-theme.el -- My configs for themes related -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My configs for themes related. Covers themes, faces etc. + +;;; Code: + + + +(my-package modus-themes + (:install t) + (setq + custom-safe-themes + '("896e4305e7c10f3217c5c0a0ef9d99240c3342414ec5bfca4ec4bff27abe2d2d")) + (setq custom-enabled-themes '(modus-operandi-tinted)) + (modus-themes-load-theme 'modus-operandi-tinted) +) + +(set-face-attribute 'default nil :family "Ubuntu Mono" :foundry "DAMA" :slant + '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) + +(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 new file mode 100644 index 0000000..bc43764 --- /dev/null +++ b/emacs/.emacs.d/init/ycp-time.el @@ -0,0 +1,141 @@ +;;; ycp-time.el -- My config for time related -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for time related. Covers date, time, calendar, holidays etc. + +;;; Code: + + + +(my-configure + (my-setq-from-local calendar-latitude calendar-longitude calendar-location-name) + (setq calendar-mark-holidays-flag t) + +;;;;; World clock (M-x world-clock) + (setq display-time-world-list t) + (setq zoneinfo-style-world-list ; timedatectl list-timezones + '(("Pacific/Honolulu" "Honolulu") + ("America/Los_Angeles" "Los Angeles") + ("America/Chicago" "Chicago") + ("America/New_York" "Boston") + ("UTC" "UTC") + ("Europe/London" "Coventry") + ("Europe/Berlin" "Berlin") + ("Africa/Khartoum" "Khartoum") + ("Europe/Helsinki" "Helsinki") + ("Asia/Dubai" "Dubai") + ("Asia/Yekaterinburg" "Yekaterinburg") + ("Asia/Calcutta" "Delhi") + ("Asia/Shanghai" "Shanghai") + ("Pacific/Auckland" "Auckland"))) + + ;; All of the following variables are for Emacs 28 + (require 'time) + (setq world-clock-list t) + (setq world-clock-time-format "%R %z %A %d %B") + (setq world-clock-buffer-name "*world-clock*") ; Placement handled by `display-buffer-alist' + (setq world-clock-timer-enable t) + (setq world-clock-timer-second 60) + + ;; Holidays + (setq holiday-other-holidays + '( + (holiday-float 4 1 3 "Sechseläuten (Burning of Böögg)") + (holiday-fixed 3 8 "Women's Day") + (holiday-chinese 4 8 "Buddha's birthday (East Asia)") + (holiday-fixed 4 26 "World Intellectual Pooperty Day") + (holiday-fixed 4 30 "Walpurgis Night") + (holiday-fixed 5 1 "May Day") + (holiday-fixed 5 12 "International Nurses Day") + (holiday-fixed 6 4 "International Nothing Happened On This Day") + (holiday-float 6 6 1 "Midsommar" 20) + (holiday-float 9 6 3 "Software Freedom Day") + (holiday-islamic 10 1 "Hari Raya Puasa") + (holiday-fixed 12 13 "St Lucia Day") + (holiday-easter-etc -47 "Fat Tuesday / Fettisdagen / Pancake Tuesday / Mardi Gras") + (holiday-easter-etc 39 "Ascension Day") + (holiday-easter-etc 60 "Corpus Christi") + ) + calendar-chinese-all-holidays-flag t + holiday-local-holidays + '( + (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-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)") + (holiday-float 11 2 1 "Melbourne Cup (Vic holiday)") + ) + holiday-general-holidays + '( + (holiday-fixed 1 1 "New Year's Day") + (holiday-fixed 2 14 "Valentine's Day") + (holiday-fixed 3 17 "St. Patrick's Day") + (holiday-fixed 4 1 "April Fools' Day") + (holiday-float 5 0 2 "Mother's Day") + (holiday-float 6 0 3 "Father's Day") + (holiday-fixed 7 4 "US Independence Day") + (holiday-fixed 10 31 "Halloween") + (holiday-float 11 4 4 "Thanksgiving") + ) + holiday-bahai-holidays + '() + holiday-hebrew-holidays + '() + ) + (setq calendar-holidays + (append holiday-general-holidays holiday-local-holidays + holiday-other-holidays holiday-christian-holidays + holiday-hebrew-holidays holiday-islamic-holidays + holiday-bahai-holidays holiday-oriental-holidays + holiday-solar-holidays + (my-get-from-local my-holiday-personal-holidays))) + (put 'list-timers 'disabled nil) + ) + +(my-package appt + (:delay 20) + (setq appt-message-warning-time 5) + (setq appt-display-duration 30) + (setq appt-display-interval 5) + ;; dbus notification of appt + (require 'my-time) + (setq appt-disp-window-function #'my-app-display-window) + ;; with org-agenda-to-appt + (require 'org-clock) + (require 'my-utils) + (when (boundp 'appt-to-agenda-timer) + (cancel-timer appt-to-agenda-timer)) + (when (my-server-p) + (setq appt-to-agenda-timer + (run-at-time + "07:00am" + 86400 #'org-agenda-to-appt)))) + +(provide 'ycp-time) +;;; ycp-time.el ends here diff --git a/emacs/.emacs.d/init/ycp-vc.el b/emacs/.emacs.d/init/ycp-vc.el new file mode 100644 index 0000000..49ef58e --- /dev/null +++ b/emacs/.emacs.d/init/ycp-vc.el @@ -0,0 +1,89 @@ +;;; ycp-vc.el -- My config for vcs related -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for vcs related. Covers diff, vc, magit, ediff etc. + +;;; Code: + + + +;;; vc, magit, diff +(my-package vc-hooks + (:delay 5) + ;;; avoid the "file is symlink to git controlled repo, follow?" + (setq vc-follow-symlinks t) +) + +;;;; `diff-mode' +(my-package diff-mode + (setq diff-default-read-only t) + (setq diff-advance-after-apply-hunk t) + (setq diff-update-on-the-fly t) + ;; The following are from Emacs 27.1 + (setq diff-font-lock-prettify t) + (setq diff-font-lock-syntax 'hunk-also) + (add-to-list 'safe-local-variable-values '(diff-add-log-use-relative-names . t))) + +(my-package ediff + (:delay 30) +;;;; `ediff' + (setq ediff-keep-variants nil) + (setq ediff-make-buffers-readonly-at-startup nil) + (setq ediff-show-clashes-only t) + (setq ediff-split-window-function 'split-window-horizontally) + (setq ediff-window-setup-function 'ediff-setup-windows-plain) + ) + +(my-package vc-git + (:delay 30) + (add-to-list 'safe-local-variable-values + '(vc-git-annotate-switches . "-w"))) + +(my-package git-commit + (:install t) + (:delay 30) + (setq git-commit-summary-max-length 50) + (setq git-commit-style-convention-checks '(non-empty-second-line))) + +(my-package magit + (:install t) + (:delay 30) + + (require 'magit-diff) + (setq magit-diff-refine-hunk t) + + (require 'magit-repos) + (my-setq-from-local magit-repository-directories) + (put 'magit-clean 'disabled nil) +) + +(my-package my-magit + (:delay 30) + (my-keybind global-map + "\C-xpM" #'my-project-magit-at)) + +(my-package magit-annex + (:delay 60)) + +(provide 'ycp-vc) diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el new file mode 100644 index 0000000..af13d5c --- /dev/null +++ b/emacs/.emacs.d/init/ycp-web.el @@ -0,0 +1,165 @@ +;;; ycp-web.el -- My config for web related -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; My config for web related. Covers cookies, web browsing, clients to +;; web services like osm and openlibrary + +;;; Code: + + + +;; disable cookies +(setq url-cookie-untrusted-urls ".*") +(ignore-errors (cancel-timer url-cookie-timer)) + +(setq shr-cookie-policy nil) + +(my-package luwak + (:delay 10) + (:install t) + (require 'luwak-org) + (require 'my-utils) + (setq luwak-url-rewrite-function 'my-rewrite-url) + (setq luwak-tor-switch nil) +) + +;;; openlibrary +(my-package my-openlibrary + (:delay 15)) + +(my-package osm + (:install t) + (:delay 30) + (require 'my-osm) + (my-keybind osm-mode-map + "C-<left>" nil + "C-<right>" nil + "C-<up>" nil + "C-<down>" nil + "c" #'my-osm-show-center) + (require 'osm-ol) + ) + +(my-package hnreader + (:delay 30) + (require 'my-hnreader) + (my-override hnreader--print-frontpage) + (my-override hnreader--print-frontpage-item) + (my-override hnreader--print-comments)) + +(my-package buildbot + (:delay 30) + (my-setq-from-local buildbot-host buildbot-github-status-builders) + (setq buildbot-builders (ignore-error (buildbot-get-all-builders))) +) + +(my-package eww + (:delay 60) + (advice-add 'eww-browse-url :filter-args #'my-rewrite-url-advice) + (advice-add 'eww :filter-args #'my-rewrite-url-advice) + (setq eww-restore-desktop t) + (setq eww-download-directory (expand-file-name "~/Downloads")) + (setq eww-bookmarks-directory (locate-user-emacs-file "eww-bookmarks")) + (setq eww-history-limit 150) + (setq eww-use-external-browser-for-content-type + "\\`\\(video/\\|audio\\)") ; On GNU/Linux check your mimeapps.list + (setq eww-browse-url-new-window-is-tab nil) + (my-keybind eww-link-keymap "v" nil) ; stop overriding `eww-view-source' + (my-keybind eww-mode-map "L" #'eww-list-bookmarks) + (my-keybind eww-bookmark-mode-map "d" #'eww-bookmark-kill) + ) + +(my-package my-web + (:delay 60) + (my-keybind eww-mode-map + "N" #'my-eww-next-path + "P" #'my-eww-prev-path + "U" #'my-eww-up-path + "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-package my-semantic-scholar + (:delay 60)) + +(my-package rt-liberation + (:delay 60) + (:install t) + (my-setq-from-local rt-liber-username rt-liber-rest-url + rt-liber-base-url) + (require 'my-rtliber) + (my-override rt-liber-viewer-visit-in-browser) +) + +(my-package rt-liberation-org + (:delay 60)) + +(my-package rt-liberation-gnus + (:delay 60) + (my-setq-from-local rt-liber-gnus-address + rt-liber-gnus-comment-address + rt-liber-gnus-subject-name) + (require 'my-rtliber) + (my-keybind global-map + "C-c t m" #'my-rt-liber-my-open-tickets + "C-c t M" #'my-rt-liber-my-tickets + "C-c t b" #'my-rt-liber-backlog + "C-c t i" #'my-rt-liber-get-ticket-by-id + "C-c t q" #'my-rt-liber-query-by-subject) + ) + +;; sx: a stack exchange client +(my-package sx + (:delay 60) + (require 'sx-load)) + +;; mastodon +(add-to-list 'load-path (locate-user-emacs-file "lisp/mastodon.el/lisp")) +(my-package mastodon + (:delay 60) + (my-setq-from-local mastodon-active-user mastodon-instance-url)) + +(add-to-list 'load-path (locate-user-emacs-file "lisp/servall/lisp")) +(my-package servall-wikipedia + (:delay 60) + (require 'servall-ytdl) + (my-setq-from-local servall-endpoint) + (require 'my-servall) + (my-keybind servall-wikipedia-view-mode-map "C-'" 'my-servall-wikipedia-grok) +) + +(my-package my-libgen + (:delay 60) + (my-setq-from-local my-libgen-hosts my-libgen-alt-hosts + my-libgen-library-hosts + my-libgen-download-dir) + (my-libgen-set-random-hosts)) + +(my-package my-scihub + (:delay 60) + (my-setq-from-local my-scihub-host)) + +(provide 'ycp-web) diff --git a/emacs/.emacs.d/lisp/bbdb-vcard b/emacs/.emacs.d/lisp/bbdb-vcard new file mode 160000 +Subproject 113c66115ce68316e209f51ebce56de8dded360 diff --git a/emacs/.emacs.d/lisp/buildbot.el b/emacs/.emacs.d/lisp/buildbot.el new file mode 160000 +Subproject 07c135a7ce5769dd2cf3076eab790d2514fef97 diff --git a/emacs/.emacs.d/lisp/dictionary-el b/emacs/.emacs.d/lisp/dictionary-el new file mode 160000 +Subproject cf38c80755d422f9b159a1cac2d38f21a186927 diff --git a/emacs/.emacs.d/lisp/dired-hacks b/emacs/.emacs.d/lisp/dired-hacks new file mode 160000 +Subproject 523f51b4152a3bf4e60fe57f512732c698b5c96 diff --git a/emacs/.emacs.d/lisp/elisp-tree-sitter b/emacs/.emacs.d/lisp/elisp-tree-sitter new file mode 160000 +Subproject 3cfab8a0e945db9b3df84437f27945746a43cc7 diff --git a/emacs/.emacs.d/lisp/emacs-crystal-mode b/emacs/.emacs.d/lisp/emacs-crystal-mode new file mode 160000 +Subproject 96a8058205b24b513d0b9307db32f05e30f9570 diff --git a/emacs/.emacs.d/lisp/emacs-hnreader b/emacs/.emacs.d/lisp/emacs-hnreader new file mode 160000 +Subproject e17006072b0cd06ab7ff32c6187e9565131a78b diff --git a/emacs/.emacs.d/lisp/emacs-promise b/emacs/.emacs.d/lisp/emacs-promise new file mode 160000 +Subproject cec51feb5f957e8febe6325335cf57dc2db6be3 diff --git a/emacs/.emacs.d/lisp/emacs-wget b/emacs/.emacs.d/lisp/emacs-wget new file mode 160000 +Subproject 8dd7abffa450eb64e8983712b054f86ad615bae diff --git a/emacs/.emacs.d/lisp/esxml b/emacs/.emacs.d/lisp/esxml new file mode 160000 +Subproject 701ccc285f3748d94c12f85636fecaa88858c17 diff --git a/emacs/.emacs.d/lisp/flycheck b/emacs/.emacs.d/lisp/flycheck new file mode 160000 +Subproject 8541a61053bba1f2f31d0791e597cd3c78a2145 diff --git a/emacs/.emacs.d/lisp/gnus-desktop-notify.el b/emacs/.emacs.d/lisp/gnus-desktop-notify.el new file mode 160000 +Subproject b438feb59136621a8ab979f0e2784f7002398d0 diff --git a/emacs/.emacs.d/lisp/hmm.el b/emacs/.emacs.d/lisp/hmm.el new file mode 160000 +Subproject 1482f0e55fafa2b2a1694adbe016eb483952532 diff --git a/emacs/.emacs.d/lisp/imgur.el b/emacs/.emacs.d/lisp/imgur.el new file mode 160000 +Subproject e179f5e3411d8eb3773e436e391e432c52e8b91 diff --git a/emacs/.emacs.d/lisp/magit-annex b/emacs/.emacs.d/lisp/magit-annex new file mode 160000 +Subproject 018e8eebd2b1e56e9e8c152c6fb249f4de52e2d diff --git a/emacs/.emacs.d/lisp/mastodon.el b/emacs/.emacs.d/lisp/mastodon.el new file mode 160000 +Subproject b3649a12a398537ade7136d704f2f05ccc856e2 diff --git a/emacs/.emacs.d/lisp/mediawiki-el b/emacs/.emacs.d/lisp/mediawiki-el new file mode 160000 +Subproject 932497604fd417964e4f04614e28d96f4eee028 diff --git a/emacs/.emacs.d/lisp/meme b/emacs/.emacs.d/lisp/meme new file mode 160000 +Subproject b59ebaa5426f13a901661d1a28e298966100acd diff --git a/emacs/.emacs.d/lisp/misc/README.org b/emacs/.emacs.d/lisp/misc/README.org new file mode 100644 index 0000000..d109e46 --- /dev/null +++ b/emacs/.emacs.d/lisp/misc/README.org @@ -0,0 +1,4 @@ +:PROPERTIES: +:UPDATED: [2023-06-09 Fri 18:09] +:END: +Third party single file modules diff --git a/emacs/.emacs.d/lisp/misc/cmake-mode.el b/emacs/.emacs.d/lisp/misc/cmake-mode.el new file mode 100644 index 0000000..3a3c296 --- /dev/null +++ b/emacs/.emacs.d/lisp/misc/cmake-mode.el @@ -0,0 +1,532 @@ +;;; cmake-mode.el --- major-mode for editing CMake sources + +;; Package-Requires: ((emacs "24.1")) + +; Distributed under the OSI-approved BSD 3-Clause License. See accompanying +; file Copyright.txt or https://cmake.org/licensing for details. + +;------------------------------------------------------------------------------ + +;;; Commentary: + +;; Provides syntax highlighting and indentation for CMakeLists.txt and +;; *.cmake source files. +;; +;; Add this code to your .emacs file to use the mode: +;; +;; (setq load-path (cons (expand-file-name "/dir/with/cmake-mode") load-path)) +;; (require 'cmake-mode) + +;------------------------------------------------------------------------------ + +;;; Code: +;; +;; cmake executable variable used to run cmake --help-command +;; on commands in cmake-mode +;; +;; cmake-command-help Written by James Bigler +;; + +;;; This file is extracted from the cmake repository (Auxiliary/cmake-mode.el) +(require 'rst) +(require 'rx) + +(defcustom cmake-mode-cmake-executable "cmake" + "*The name of the cmake executable. + +This can be either absolute or looked up in $PATH. You can also +set the path with these commands: + (setenv \"PATH\" (concat (getenv \"PATH\") \";C:\\\\Program Files\\\\CMake 2.8\\\\bin\")) + (setenv \"PATH\" (concat (getenv \"PATH\") \":/usr/local/cmake/bin\"))" + :type 'file + :group 'cmake) + +;; Keywords +(defconst cmake-keywords-block-open '("BLOCK" "IF" "MACRO" "FOREACH" "ELSE" "ELSEIF" "WHILE" "FUNCTION")) +(defconst cmake-keywords-block-close '("ENDBLOCK" "ENDIF" "ENDFOREACH" "ENDMACRO" "ELSE" "ELSEIF" "ENDWHILE" "ENDFUNCTION")) +(defconst cmake-keywords + (let ((kwds (append cmake-keywords-block-open cmake-keywords-block-close nil))) + (delete-dups kwds))) + +;; Regular expressions used by line indentation function. +;; +(defconst cmake-regex-blank "^[ \t]*$") +(defconst cmake-regex-comment "#.*") +(defconst cmake-regex-paren-left "(") +(defconst cmake-regex-paren-right ")") +(defconst cmake-regex-closing-parens-line (concat "^[[:space:]]*\\(" + cmake-regex-paren-right + "+\\)[[:space:]]*$")) +(defconst cmake-regex-argument-quoted + (rx ?\" (* (or (not (any ?\" ?\\)) (and ?\\ anything))) ?\")) +(defconst cmake-regex-argument-unquoted + (rx (or (not (any space "()#\"\\\n")) (and ?\\ nonl)) + (* (or (not (any space "()#\\\n")) (and ?\\ nonl))))) +(defconst cmake-regex-token + (rx-to-string `(group (or (regexp ,cmake-regex-comment) + ?\( ?\) + (regexp ,cmake-regex-argument-unquoted) + (regexp ,cmake-regex-argument-quoted))))) +(defconst cmake-regex-indented + (rx-to-string `(and bol (* (group (or (regexp ,cmake-regex-token) (any space ?\n))))))) +(defconst cmake-regex-block-open + (rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-open + (mapcar 'downcase cmake-keywords-block-open))) symbol-end))) +(defconst cmake-regex-block-close + (rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-close + (mapcar 'downcase cmake-keywords-block-close))) symbol-end))) +(defconst cmake-regex-close + (rx-to-string `(and bol (* space) (regexp ,cmake-regex-block-close) + (* space) (regexp ,cmake-regex-paren-left)))) +(defconst cmake-regex-token-paren-left (concat "^" cmake-regex-paren-left "$")) +(defconst cmake-regex-token-paren-right (concat "^" cmake-regex-paren-right "$")) + +;------------------------------------------------------------------------------ + +;; Line indentation helper functions + +(defun cmake-line-starts-inside-string () + "Determine whether the beginning of the current line is in a string." + (save-excursion + (beginning-of-line) + (let ((parse-end (point))) + (goto-char (point-min)) + (nth 3 (parse-partial-sexp (point) parse-end)) + ) + ) + ) + +(defun cmake-find-last-indented-line () + "Move to the beginning of the last line that has meaningful indentation." + (let ((point-start (point)) + region) + (forward-line -1) + (setq region (buffer-substring-no-properties (point) point-start)) + (while (and (not (bobp)) + (or (looking-at cmake-regex-blank) + (cmake-line-starts-inside-string) + (not (and (string-match cmake-regex-indented region) + (= (length region) (match-end 0)))))) + (forward-line -1) + (setq region (buffer-substring-no-properties (point) point-start)) + ) + ) + ) + +;------------------------------------------------------------------------------ + +;; +;; Indentation increment. +;; +(defcustom cmake-tab-width 2 + "Number of columns to indent cmake blocks" + :type 'integer + :group 'cmake) + +;; +;; Line indentation function. +;; +(defun cmake-indent () + "Indent current line as CMake code." + (interactive) + (unless (cmake-line-starts-inside-string) + (if (bobp) + (cmake-indent-line-to 0) + (let (cur-indent) + (save-excursion + (beginning-of-line) + (let ((point-start (point)) + (closing-parens-only (looking-at cmake-regex-closing-parens-line)) + (case-fold-search t) ;; case-insensitive + token) + ;; Search back for the last indented line. + (cmake-find-last-indented-line) + ;; Start with the indentation on this line. + (setq cur-indent (current-indentation)) + (if closing-parens-only + (let ((open-parens 0)) + (while (re-search-forward cmake-regex-token point-start t) + (setq token (match-string 0)) + (cond + ((string-match cmake-regex-token-paren-left token) + (setq open-parens (+ open-parens 1))) + ((string-match cmake-regex-token-paren-right token) + (setq open-parens (- open-parens 1))))) + ;; Don't outdent if last indented line has open parens + (unless (> open-parens 0) + (setq cur-indent (- cur-indent cmake-tab-width)))) + ;; Skip detailed analysis if last indented line is a 'closing + ;; parens only line' + (unless (looking-at cmake-regex-closing-parens-line) + ;; Search forward counting tokens that adjust indentation. + (while (re-search-forward cmake-regex-token point-start t) + (setq token (match-string 0)) + (when (or (string-match cmake-regex-token-paren-left token) + (and (string-match cmake-regex-block-open token) + (looking-at (concat "[ \t]*" cmake-regex-paren-left)))) + (setq cur-indent (+ cur-indent cmake-tab-width))) + (when (string-match cmake-regex-token-paren-right token) + (setq cur-indent (- cur-indent cmake-tab-width))) + )) + (goto-char point-start) + ;; If next token closes the block, decrease indentation + (when (looking-at cmake-regex-close) + (setq cur-indent (- cur-indent cmake-tab-width)) + ) + ) + ) + ) + ;; Indent this line by the amount selected. + (cmake-indent-line-to (max cur-indent 0)) + ) + ) + ) + ) + +(defun cmake-point-in-indendation () + (string-match "^[ \\t]*$" (buffer-substring (point-at-bol) (point)))) + +(defun cmake-indent-line-to (column) + "Indent the current line to COLUMN. +If point is within the existing indentation it is moved to the end of +the indentation. Otherwise it retains the same position on the line" + (if (cmake-point-in-indendation) + (indent-line-to column) + (save-excursion (indent-line-to column)))) + +;------------------------------------------------------------------------------ + +;; +;; Helper functions for buffer +;; +(defun cmake-unscreamify-buffer () + "Convert all CMake commands to lowercase in buffer." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\([ \t]*\\)\\_<\\(\\(?:\\w\\|\\s_\\)+\\)\\_>\\([ \t]*(\\)" nil t) + (replace-match + (concat + (match-string 1) + (downcase (match-string 2)) + (match-string 3)) + t)) + ) + ) + + +;------------------------------------------------------------------------------ + +;; +;; Navigation / marking by function or macro +;; + +(defconst cmake--regex-defun-start + (rx line-start + (zero-or-more space) + (or "function" "macro") + (zero-or-more space) + "(")) + +(defconst cmake--regex-defun-end + (rx line-start + (zero-or-more space) + "end" + (or "function" "macro") + (zero-or-more space) + "(" (zero-or-more (not-char ")")) ")")) + +(defun cmake-beginning-of-defun () + "Move backward to the beginning of a CMake function or macro. + +Return t unless search stops due to beginning of buffer." + (interactive) + (when (not (region-active-p)) + (push-mark)) + (let ((case-fold-search t)) + (when (re-search-backward cmake--regex-defun-start nil 'move) + t))) + +(defun cmake-end-of-defun () + "Move forward to the end of a CMake function or macro. + +Return t unless search stops due to end of buffer." + (interactive) + (when (not (region-active-p)) + (push-mark)) + (let ((case-fold-search t)) + (when (re-search-forward cmake--regex-defun-end nil 'move) + (forward-line) + t))) + +(defun cmake-mark-defun () + "Mark the current CMake function or macro. + +This puts the mark at the end, and point at the beginning." + (interactive) + (cmake-end-of-defun) + (push-mark nil :nomsg :activate) + (cmake-beginning-of-defun)) + + +;------------------------------------------------------------------------------ + +;; +;; Keyword highlighting regex-to-face map. +;; +(defconst cmake-font-lock-keywords + `((,(rx-to-string `(and symbol-start + (or ,@cmake-keywords + ,@(mapcar #'downcase cmake-keywords)) + symbol-end)) + . font-lock-keyword-face) + (,(rx symbol-start (group (+ (or word (syntax symbol)))) (* blank) ?\() + 1 font-lock-function-name-face) + (,(rx "${" (group (+(any alnum "-_+/."))) "}") + 1 font-lock-variable-name-face t) + ) + "Highlighting expressions for CMake mode.") + +;------------------------------------------------------------------------------ + +(defun cmake--syntax-propertize-until-bracket-close (syntax) + ;; This function assumes that a previous search has matched the + ;; beginning of a bracket_comment or bracket_argument and that the + ;; second capture group has matched the equal signs between the two + ;; opening brackets + (let* ((mb (match-beginning 2)) + (me (match-end 2)) + (cb (format "]%s]" (buffer-substring mb me)))) + (save-match-data + (if (search-forward cb end 'move) + (progn + (setq me (match-end 0)) + (put-text-property + (1- me) + me + 'syntax-table + (string-to-syntax syntax))) + (setq me end))) + (put-text-property + (match-beginning 1) + me + 'syntax-multiline + t))) + +(defconst cmake--syntax-propertize-function + (syntax-propertize-rules + ("\\(#\\)\\[\\(=*\\)\\[" + (1 + (prog1 "!" (cmake--syntax-propertize-until-bracket-close "!")))) + ("\\(\\[\\)\\(=*\\)\\[" + (1 + (prog1 "|" (cmake--syntax-propertize-until-bracket-close "|")))))) + +;; Syntax table for this mode. +(defvar cmake-mode-syntax-table nil + "Syntax table for CMake mode.") +(or cmake-mode-syntax-table + (setq cmake-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?$ "'" table) + table))) + +;; +;; User hook entry point. +;; +(defvar cmake-mode-hook nil) + +;;------------------------------------------------------------------------------ +;; Mode definition. +;; +;;;###autoload +(define-derived-mode cmake-mode prog-mode "CMake" + "Major mode for editing CMake source files." + + ; Setup font-lock mode. + (set (make-local-variable 'font-lock-defaults) '(cmake-font-lock-keywords)) + ; Setup indentation function. + (set (make-local-variable 'indent-line-function) 'cmake-indent) + ; Setup comment syntax. + (set (make-local-variable 'comment-start) "#") + ;; Setup syntax propertization + (set (make-local-variable 'syntax-propertize-function) cmake--syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline nil t)) + +;; Default cmake-mode key bindings +(define-key cmake-mode-map "\e\C-a" #'cmake-beginning-of-defun) +(define-key cmake-mode-map "\e\C-e" #'cmake-end-of-defun) +(define-key cmake-mode-map "\e\C-h" #'cmake-mark-defun) + + +; Help mode starts here + + +;;;###autoload +(defun cmake-command-run (type &optional topic buffer) + "Runs the command cmake with the arguments specified. The +optional argument topic will be appended to the argument list." + (interactive "s") + (let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*"))) + (buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname))) + (command (concat cmake-mode-cmake-executable " " type " " topic)) + ;; Turn of resizing of mini-windows for shell-command. + (resize-mini-windows nil) + ) + (shell-command command buffer) + (save-selected-window + (select-window (display-buffer buffer 'not-this-window)) + (cmake-mode) + (read-only-mode 1) + (view-mode 1)) + ) + ) + +;;;###autoload +(defun cmake-command-run-help (type &optional topic buffer) + "`cmake-command-run' but rendered in `rst-mode'." + (interactive "s") + (let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*"))) + (buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname))) + (command (concat cmake-mode-cmake-executable " " type " " topic)) + ;; Turn of resizing of mini-windows for shell-command. + (resize-mini-windows nil) + ) + (shell-command command buffer) + (save-selected-window + (select-window (display-buffer buffer 'not-this-window)) + (rst-mode) + (read-only-mode 1) + (view-mode 1)) + ) + ) + +;;;###autoload +(defun cmake-help-list-commands () + "Prints out a list of the cmake commands." + (interactive) + (cmake-command-run-help "--help-command-list") + ) + +(defvar cmake-commands '() "List of available topics for --help-command.") +(defvar cmake-help-command-history nil "Command read history.") +(defvar cmake-modules '() "List of available topics for --help-module.") +(defvar cmake-help-module-history nil "Module read history.") +(defvar cmake-variables '() "List of available topics for --help-variable.") +(defvar cmake-help-variable-history nil "Variable read history.") +(defvar cmake-properties '() "List of available topics for --help-property.") +(defvar cmake-help-property-history nil "Property read history.") +(defvar cmake-help-complete-history nil "Complete help read history.") +(defvar cmake-string-to-list-symbol + '(("command" cmake-commands cmake-help-command-history) + ("module" cmake-modules cmake-help-module-history) + ("variable" cmake-variables cmake-help-variable-history) + ("property" cmake-properties cmake-help-property-history) + )) + +(defun cmake-get-list (listname) + "If the value of LISTVAR is nil, run cmake --help-LISTNAME-list +and store the result as a list in LISTVAR." + (let ((listvar (car (cdr (assoc listname cmake-string-to-list-symbol))))) + (if (not (symbol-value listvar)) + (let ((temp-buffer-name "*CMake Temporary*")) + (save-window-excursion + (cmake-command-run-help (concat "--help-" listname "-list") nil temp-buffer-name) + (with-current-buffer temp-buffer-name + ; FIXME: Ignore first line if it is "cmake version ..." from CMake < 3.0. + (set listvar (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n" t))))) + (symbol-value listvar) + )) + ) + +(require 'thingatpt) +(defun cmake-symbol-at-point () + (let ((symbol (symbol-at-point))) + (and (not (null symbol)) + (symbol-name symbol)))) + +(defun cmake-help-type (type) + (let* ((default-entry (cmake-symbol-at-point)) + (history (car (cdr (cdr (assoc type cmake-string-to-list-symbol))))) + (input (completing-read + (format "CMake %s: " type) ; prompt + (cmake-get-list type) ; completions + nil ; predicate + t ; require-match + default-entry ; initial-input + history + ))) + (if (string= input "") + (error "No argument given") + input)) + ) + +;;;###autoload +(defun cmake-help-command () + "Prints out the help message for the command the cursor is on." + (interactive) + (cmake-command-run-help "--help-command" (cmake-help-type "command") "*CMake Help*")) + +;;;###autoload +(defun cmake-help-module () + "Prints out the help message for the module the cursor is on." + (interactive) + (cmake-command-run-help "--help-module" (cmake-help-type "module") "*CMake Help*")) + +;;;###autoload +(defun cmake-help-variable () + "Prints out the help message for the variable the cursor is on." + (interactive) + (cmake-command-run-help "--help-variable" (cmake-help-type "variable") "*CMake Help*")) + +;;;###autoload +(defun cmake-help-property () + "Prints out the help message for the property the cursor is on." + (interactive) + (cmake-command-run-help "--help-property" (cmake-help-type "property") "*CMake Help*")) + +;;;###autoload +(defun cmake-help () + "Queries for any of the four available help topics and prints out the appropriate page." + (interactive) + (let* ((default-entry (cmake-symbol-at-point)) + (command-list (cmake-get-list "command")) + (variable-list (cmake-get-list "variable")) + (module-list (cmake-get-list "module")) + (property-list (cmake-get-list "property")) + (all-words (append command-list variable-list module-list property-list)) + (input (completing-read + "CMake command/module/variable/property: " ; prompt + all-words ; completions + nil ; predicate + t ; require-match + default-entry ; initial-input + 'cmake-help-complete-history + ))) + (if (string= input "") + (error "No argument given") + (if (member input command-list) + (cmake-command-run-help "--help-command" input "*CMake Help*") + (if (member input variable-list) + (cmake-command-run-help "--help-variable" input "*CMake Help*") + (if (member input module-list) + (cmake-command-run-help "--help-module" input "*CMake Help*") + (if (member input property-list) + (cmake-command-run-help "--help-property" input "*CMake Help*") + (error "Not a know help topic.") ; this really should not happen + )))))) + ) + +;;;###autoload +(progn + (add-to-list 'auto-mode-alist '("CMakeLists\\.txt\\'" . cmake-mode)) + (add-to-list 'auto-mode-alist '("\\.cmake\\'" . cmake-mode))) + +; This file provides cmake-mode. +(provide 'cmake-mode) + +;;; cmake-mode.el ends here diff --git a/emacs/.emacs.d/lisp/my/emms-info-ytdl.el b/emacs/.emacs.d/lisp/my/emms-info-ytdl.el new file mode 100644 index 0000000..489f3fb --- /dev/null +++ b/emacs/.emacs.d/lisp/my/emms-info-ytdl.el @@ -0,0 +1,100 @@ +;;; emms-info-ytdl.el --- info-method for EMMS using ytdl -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Yuchen Pei (ycp@gnu.org) +;; Keywords: multimedia + +;; EMMS is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; EMMS 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 General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with EMMS; see the file COPYING.. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; (add-to-list emms-info-functions 'emms-info-ytdl) + +;; To use this you would need to have `emms-info-ytdl-command` +;; (typically youtube-dl or yt-dlp) installed on your system. + + +;;; Code: + +(require 'emms-info) +(require 'json) + + +(defgroup emms-info-ytdl nil + "Options for EMMS." + :group 'emms-info) + +(defvar emms-info-ytdl-field-map + '((info-title . title) + (info-artist . artist) + (info-playing-time . duration)) + "Mapping for ytdl output.") + +(defvar emms-info-ytdl-regexp + "^https?://" + "Regexp to use ytdl to get info.") + +(defvar emms-info-ytdl-exclude-regexp + ;; "\\(\\.\\w+$\\|/playlist\\|/channel\\)" + "\\(/playlist\\|/channel\\)" + "Regexp not to use ytdl to get info.") + +(defvar emms-info-ytdl-command + "yt-dlp" + "Command to run for emms-info-ytdl.") + +(defcustom emms-info-ytdl-using-torsocks + nil + "If t, use torsocks to get ytdl info") + +(defun emms-info-ytdl (track) + "Set TRACK info using ytdl." + (when (and (eq (emms-track-type track) 'url) + (string-match emms-info-ytdl-regexp (emms-track-name track)) + (not + (string-match emms-info-ytdl-exclude-regexp + (emms-track-name track)))) + (with-temp-buffer + (when (zerop + (let ((coding-system-for-read 'utf-8)) + (if emms-info-ytdl-using-torsocks + (my-call-process-with-torsocks + emms-info-ytdl-command nil '(t nil) nil "-j" + (emms-track-name track)) + (call-process emms-info-ytdl-command nil '(t nil) nil + "-j" (emms-track-name track))))) + (goto-char (point-min)) + (condition-case nil + (let ((json-fields (json-read))) + (mapc + (lambda (field-map) + (let ((emms-field (car field-map)) + (ytdl-field (cdr field-map))) + (let ((track-field (assoc ytdl-field json-fields))) + (when track-field + (emms-track-set + track + emms-field + (if (eq emms-field 'info-playing-time) + (truncate (cdr track-field)) + (cdr track-field))))))) + emms-info-ytdl-field-map)) + (error (message "error while reading track info"))) + track)))) + +(provide 'emms-info-ytdl) + +;;; emms-info-ytdl.el ends here diff --git a/emacs/.emacs.d/lisp/my/generic-search.el b/emacs/.emacs.d/lisp/my/generic-search.el new file mode 100644 index 0000000..3db5b08 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/generic-search.el @@ -0,0 +1,99 @@ +;;; generic-search.el -- A search result UI -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; A search result UI. A generic search result mode displaying a list +;; of things, and action on an item + + +;;; Code: + +(defvar-local generic-search-transformer nil) +(defvar-local generic-search-formatter nil) +(defvar-local generic-search-default-action nil) +(defvar-local generic-search-results nil) +(defvar-local generic-search-keymap nil) + +(defvar generic-search-default-transformer 'identity) +(defvar generic-search-default-formatter 'pp) +(defvar generic-search-default-default-action 'generic-search-message-pp) +(defvar generic-search-default-keymap button-map) + +(defun generic-search-message-pp (data) + (interactive) + (message (pp data))) + +(define-derived-mode generic-search-mode special-mode "Generic search" + "Search results.") + +(defun generic-search-buffer-name (name) + (format "*generic-search %s*" name)) + +(defun generic-search-open (results name &optional display-options) + (let ((buffer-name (generic-search-buffer-name name))) + (with-current-buffer (get-buffer-create buffer-name) + (generic-search-mode) + (setq generic-search-results results + generic-search-formatter + (or (alist-get 'formatter display-options) + generic-search-default-formatter) + generic-search-default-action + (or (alist-get 'default-action display-options) + generic-search-default-default-action) + generic-search-keymap + (or (alist-get 'keymap display-options) + generic-search-default-keymap) + generic-search-transformer + (or (alist-get 'transfomer display-options + generic-search-default-transformer))) + (generic-search-update) + (switch-to-buffer-other-window buffer-name)))) + +(defun generic-search-update () + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "%s Results:" (length generic-search-results))) + (seq-do (lambda (result) + (insert "\n----\n") + (let ((start (point))) + (insert + (funcall generic-search-formatter result)) + (make-text-button start (point) + 'action generic-search-default-action + 'button-data + (funcall generic-search-transformer result) + 'keymap generic-search-keymap))) + generic-search-results) + (goto-char (point-min)) + (forward-button 1))) + +(defun generic-search-refresh () + (interactive) + (generic-search-update)) + +(define-key generic-search-mode-map "\t" 'forward-button) +(define-key generic-search-mode-map [backtab] 'backward-button) +(define-key generic-search-mode-map "g" 'generic-search-refresh) + +(provide 'generic-search) diff --git a/emacs/.emacs.d/lisp/my/link-gopher.el b/emacs/.emacs.d/lisp/my/link-gopher.el new file mode 100644 index 0000000..cf8b47a --- /dev/null +++ b/emacs/.emacs.d/lisp/my/link-gopher.el @@ -0,0 +1,113 @@ +;;; link-gopher.el -- Find and filter urls -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Find and filter urls. + +;;; Code: +(require 'my-utils) + +;;; todo: some of these functions could be unnecessary +(defun link-gopher-kill-all-links (url filter-regexp) + (interactive (list (read-string "URL: " + (thing-at-point-url-at-point)) + (read-string "Regexp: "))) + (let ((results (link-gopher-get-all-links url filter-regexp))) + (kill-new (string-join results " ")) + (message "Added %d links to the kill ring!" (length results)))) +(defun link-gopher-kill-all-links-in-buffer (filter-regexp) + "may not report accurate links e.g. when the link contains special chars like space" + (interactive "sRegexp: ") + (let ((links (link-gopher-get-all-links-in-buffer filter-regexp))) + (kill-new (string-join links " ")) + (message "Added %d links to the kill ring!" (length links)))) +(defun link-gopher-get-all-links (url filter-regexp) + "get all links satisfying a regexp on url. +no duplicates." + (with-current-buffer (url-retrieve-synchronously url) + (my-skip-http-header) + (let ((results) (clean-url) (hash (make-hash-table :test 'equal))) + (while (re-search-forward + "\\(href\\|HREF\\|src\\|SRC\\)\\ *=\\ *['\"]\\([^\"']+\\)['\"]" nil t) + (setq clean-url (link-gopher-clean-url (match-string 2) url)) + (when (or (not filter-regexp) + (string-match filter-regexp clean-url)) + (when (not (gethash clean-url hash)) + (puthash clean-url t hash) + (push clean-url results)))) + (reverse results)))) +(defun link-gopher-clean-url (url current-url) + "clean url + hello - filename: hello + /hello - type: nil; host: nil; filename: /hello + //hello - type: nil; host: hello; filename: empty string +removing frags +" + (let* ((current-domain + (progn (string-match "^\\(.*://[^/]+/\\)" current-url) + (match-string 1 current-url))) + (current-domain-dir-path + (progn (string-match "^\\(.*/\\)" current-url) + (match-string 1 current-url))) + (url-no-frags (replace-regexp-in-string "#.*" "" url))) + (url-encode-url + (cond ((string-match "://" url-no-frags) url-no-frags) + ((string-match "^//" url-no-frags) (concat "https:" url-no-frags)) + ((string-match "^/" url-no-frags) (concat current-domain url-no-frags)) + (t (concat current-domain-dir-path url-no-frags)))))) +(defun link-gopher-get-all-links-in-buffer (filter-regexp) + (let ((results) (hash (make-hash-table :test 'equal))) + (save-excursion + (goto-char (point-min)) + (while + (progn + (when-let ((url (get-text-property (point) 'shr-url))) + (when (or (not filter-regexp) + (string-match filter-regexp url)) + (when (not (gethash url hash)) + (puthash url t hash) + (push url results)))) + (when-let ((next-change-point + (next-single-property-change (point) 'shr-url))) + (goto-char next-change-point))))) + results)) + +(defun http-s-links-in-buffer (&optional filter-regexp) + (save-excursion + (unless filter-regexp (setq filter-regexp ".*")) + (let ((results) (url)) + (while (re-search-forward "\\(http\\(s\\)://[^\" \n]+\\)" nil t) + (setq url (match-string 1)) + (when (and (string-match filter-regexp url) + (not (member url results))) + (push url results))) + (reverse results)))) + +(defun http-s-media-links-in-buffer () + (http-s-links-in-buffer + "\\.\\(jpg\\|png\\|gif\\|webp\\|mp4\\|flv\\|mkv\\|mov\\|webm\\|ogv\\|avi\\|rmvb\\|mp3\\|ogg\\|opus\\|pdf\\|docx\\|epub\\)$")) + +(provide 'link-gopher) +;;; link-gopher.el ends here + diff --git a/emacs/.emacs.d/lisp/my/my-algo.el b/emacs/.emacs.d/lisp/my/my-algo.el new file mode 100644 index 0000000..f3e8bc8 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-algo.el @@ -0,0 +1,72 @@ +;;; my-algo.el -- Algorithms related exentions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Algorithms and data structure. + +;;; Code: + +;;; radix tree with string array +(require 'radix-tree) +(defun my-compare-string-arrays (xs1 start1 end1 xs2 start2 end2) + (let* ((i 0) + (s1 (or start1 0)) + (e1 (or end1 (length xs1))) + (s2 (or start2 0)) + (e2 (or end2 (length xs2))) + (l1 (- e1 s1)) + (l2 (- e2 s2)) + (cmp t)) + (while (and (< i l1) (< i l2) (eq t cmp)) + (setq cmp (compare-strings (elt xs1 (+ s1 i)) nil nil + (elt xs2 (+ s2 i)) nil nil)) + (setq i (1+ i))) + (cond ((and (numberp cmp) (< cmp 0)) (- i)) + ((and (numberp cmp) (> cmp 0)) i) + ((= l1 l2) t) + ((< l1 l2) (- i)) + (t i)))) + +(defun my-radix-tree-from-list () + (goto-char (point-min)) + (let ((result radix-tree-empty) + (radix-tree-compare-function 'my-compare-string-arrays)) + (while (not (eobp)) + (let ((line (vconcat + (split-string + (buffer-substring-no-properties + (point) + (progn (forward-line 1) (1- (point)))) + "/")))) + (setq result + (radix-tree-insert result line t)))) + result)) + +(defun my-kill-radix-tree-from-list () + (interactive) + (let ((max-lisp-eval-depth 8000)) + (kill-new (pp (my-radix-tree-from-list))))) + +(provide 'my-algo) +;;; my-algo.el ends here + diff --git a/emacs/.emacs.d/lisp/my/my-bbdb.el b/emacs/.emacs.d/lisp/my/my-bbdb.el new file mode 100644 index 0000000..80661cd --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-bbdb.el @@ -0,0 +1,190 @@ +;;; my-bbdb.el -- Extensions for bbdb -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for bbdb. + +;;; Code: + + +;; overrides bbdb-read-record in bbdb-com.el +(defun my-bbdb-read-record (&optional first-and-last) + "Read and return a new BBDB record. +Does not insert it into the database or update the hashtables, +but does ensure that there will not be name collisions." + (bbdb-editable) + (let ((record (bbdb-empty-record))) + ;; name + (let (name) + (bbdb-error-retry + (setq name (bbdb-read-name first-and-last)) + (bbdb-check-name (car name) (cdr name))) + (bbdb-record-set-firstname record (car name)) + (bbdb-record-set-lastname record (cdr name))) + + ;; akas + (bbdb-record-set-aka record + (bbdb-split 'aka (bbdb-read-string "AKAs: "))) + + ;; urls + (bbdb-record-set-xfield record 'url (bbdb-read-string "urls: ")) + + ;; mail + (bbdb-record-set-mail + record (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: "))) + + ;; notes + (bbdb-record-set-xfield record 'notes (bbdb-read-string "notes: ")) + + record)) + +;; overrides bbdb-create +;;;###autoload +(defun my-bbdb-create (record) + "Add a new RECORD to BBDB. +When called interactively read all relevant info. +Do not call this from a program; call `bbdb-create-internal' instead." + (interactive (list (bbdb-read-record current-prefix-arg))) + (bbdb-change-record record) + (bbdb-display-records (list record) nil nil t)) + +(defun my-bbdb-form (name) + "Insert or update a bbdb record using a form. + +If NAME exists in bbdb, update. Otherwise insert." + (interactive + (list (completing-read "Name: " (mapcar 'bbdb-record-name (bbdb-records))))) + (let* ((record (or (car (bbdb-gethash name)) + (bbdb-empty-record))) + (new-first-name) (new-last-name)) + (switch-to-buffer-other-window "*Form BBDB*") + (kill-all-local-variables) + (let ((inhibit-read-only t)) (erase-buffer)) + (remove-overlays) + (widget-insert "BBDB form\n\n") + (setq my-bbdb-widget-first-name + (widget-create 'editable-field :format "First Name: %v" + (or (bbdb-record-firstname record) + (car (bbdb-divide-name name))))) + (setq my-bbdb-widget-last-name + (widget-create 'editable-field :format "Last Name: %v" + (or (bbdb-record-lastname record) + (cdr (bbdb-divide-name name))))) + (setq my-bbdb-widget-aka + (widget-create 'editable-field + :format "Aliases: %v" + :value (bbdb-concat + 'aka + (bbdb-record-aka record)))) + (setq my-bbdb-widget-org + (widget-create 'editable-field + :format "Organisations: %v" + :value (bbdb-concat + 'organization + (bbdb-record-organization record)))) + (setq my-bbdb-widget-mail + (widget-create 'editable-field + :format "Email addresses: %v" + :value (bbdb-concat 'mail (bbdb-record-mail record)))) + (widget-insert "Phone numbers\n") + (setq my-bbdb-widget-phone + (widget-create 'editable-list + :entry-format "%i %d %v" + :value + (mapcar (lambda (phone-info) + (list (aref phone-info 0) + (aref phone-info 1))) + (bbdb-record-phone record)) + '(group + (menu-choice + :tag "Type" + (choice-item :value "cell") + (choice-item :value "work") + (choice-item :value "home") + (choice-item :value "other")) + (editable-field :format "number: %v" "")))) + (widget-create + 'push-button + :notify (lambda (&rest _) + (setq new-first-name (widget-value my-bbdb-widget-first-name)) + (setq new-last-name (widget-value my-bbdb-widget-last-name)) + (unless (equal name + (bbdb-concat 'name-first-last new-first-name + new-last-name)) + (bbdb-check-name new-first-name new-last-name)) + (bbdb-record-set-name record new-first-name new-last-name) + (bbdb-record-set-organization + record (bbdb-split 'organization (widget-value my-bbdb-widget-org))) + (bbdb-record-set-mail + record (bbdb-split 'mail (widget-value my-bbdb-widget-mail))) + (bbdb-record-set-aka + record (bbdb-split 'aka (widget-value my-bbdb-widget-aka))) + (bbdb-record-set-phone + record (mapcar + (lambda (pair) + (vector (car pair) (cadr pair))) + (widget-value my-bbdb-widget-phone))) + (bbdb-change-record record) + (bbdb-display-records (list record) nil nil t)) + "Submit")) + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min))) + +(defun my-bbdb-parse-record (record) + (list + (cons 'Name (bbdb-record-name record)) + (cons 'First-name (bbdb-record-firstname record)) + (cons 'Last-name (bbdb-record-lastname record)) + (cons 'Organisation (car (bbdb-record-organization record))) + (cons 'Notes (bbdb-record-xfield record 'notes)) + (cons 'Website (bbdb-record-xfield record 'url)))) + +(defun my-bbdb-insert-record-to-org (parsed) + (goto-char (point-min)) + (insert "\n* "(alist-get 'Name parsed)) + (insert "\n" (or + (and (alist-get 'Notes parsed) + (format "- %s" (alist-get 'Notes parsed))) + "")) + (dolist (pair parsed) + (when (and (not (member (car pair) '(Name Notes))) (cdr pair)) + (org-set-property (symbol-name (car pair)) (cdr pair))))) + +(defun my--bbdb-to-org () + "ONLY do this in a new buffer!" + (dolist (record (bbdb-records)) + (my-bbdb-insert-record-to-org (my-bbdb-parse-record record)))) + +(defun my-bbdb-done () + "Save and quit bbdb window" + (interactive) + (bbdb-save) (quit-window)) + +(defun my-bbdb-all () + "Dispaly all bbdb records" + (interactive) + (bbdb "")) + +(provide 'my-bbdb) +;;; my-bbdb.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-buffer.el b/emacs/.emacs.d/lisp/my/my-buffer.el new file mode 100644 index 0000000..5ff09a7 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-buffer.el @@ -0,0 +1,448 @@ +;;; my-buffer.el -- Buffers and windows related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions on buffers and windows. + +;;; Code: + +;; Much of the following is from prot-emacs +(defun my-get-major-mode-for-buffer (buffer) + (buffer-local-value 'major-mode (get-buffer buffer))) + +;;; Copied from mastering emacs +;;; https://www.masteringemacs.org/article/demystifying-emacs-window-manager +(defun my-buffer-make-display-matcher (major-modes) + (lambda (buffer-name action) + (with-current-buffer buffer-name (apply #'derived-mode-p major-modes)))) + +(defun my-get-buffer-modes () + (let ((results)) + (dolist (buffer (buffer-list) results) + (add-to-list 'results (my-get-major-mode-for-buffer buffer))))) + +(defun my-switch-to-buffer-matching-major-mode (mode) + (interactive + (list (intern (completing-read "Major mode: " + (mapcar 'prin1-to-string (my-get-buffer-modes)))))) + (switch-to-buffer + (read-buffer "Switch to buffer: " nil t + (lambda (pair) + (with-current-buffer (cdr pair) + (derived-mode-p mode)))))) + +(defun my--buffer-major-mode-prompt () + "Prompt of `my-buffers-major-mode'." + (let ((major major-mode) + (read-buffer-function nil)) + (read-buffer + (format "Buffer for %s: " major) + nil t + (lambda (pair) ; pair is (name-string . buffer-object) + (with-current-buffer (cdr pair) (derived-mode-p major)))))) + +;;;###autoload +(defun my-buffers-major-mode (&optional arg) + "Select BUFFER matching the current one's major mode. + +With a prefix-arg, prompt for major mode." + (interactive "P") + (if arg + (call-interactively 'my-switch-to-buffer-matching-major-mode) + (switch-to-buffer (my--buffer-major-mode-prompt)))) + +(defun my-buffer-quick-major-mode (mode) + "Switch to the first buffer of a given mode." + (let ((buffers (buffer-list))) + (while (and buffers + (with-current-buffer (car buffers) + (not (derived-mode-p mode)))) + (setq buffers (cdr buffers))) + (if buffers + (pop-to-buffer (car buffers)) + (message "No buffers in %S" mode)))) + +(defun my-buffer-switch-or-create-major-mode (mode) + "Switch to or create a buffer with a chosen major mode. + +Prompt for a major mode, then: +With no prefix: switch to the first buffer of the chosen major mode. +With one prefix: prompt for a buffer of the chosen major mode. +With two prefixes: create a buffer of the chosen major mode." + (interactive (list (my-read-major-mode))) + (pcase (prefix-numeric-value current-prefix-arg) + (16 (my-buffer-create-major-mode mode)) + (4 (my-switch-to-buffer-matching-major-mode (print mode))) + (_ (my-buffer-quick-major-mode mode)))) + +(defvar my-buffer-create-functions nil + "List indicating ways to create new buffer for a function, each + element in the form of (major-mode-name + . buffer-create-function). without specifying, the default + buffer-create-function is `my-buffer-create-scratch'.") + +(defun my-read-major-mode () + (intern + (completing-read + "Major mode: " + (cl-loop for sym symbols of obarray + when (and (functionp sym) + ;; we would like to include all modes + (provided-mode-derived-p + sym + 'text-mode 'prog-mode + 'comint-mode 'special-mode)) + collect sym)))) + +(defun my-buffer-create-major-mode (mode) + (if (alist-get mode my-buffer-create-functions) + (call-interactively (alist-get mode my-buffer-create-functions)) + (my-buffer-scratch-setup "" mode))) + +(defun my-buffer-create-same-mode (&optional arg) + (interactive "P") + (let ((mode (if arg + (my-read-major-mode) + major-mode))) + (my-buffer-create-major-mode mode))) + +(defvar my-buffers-same-mode nil + "Buffers of the same mode for cycling") + +(defun my-buffer-with-same-major-mode-p (other-buffer) + (let ((mode major-mode)) + (with-current-buffer other-buffer + (derived-mode-p mode)))) + +(defun my-buffer-cycle-same-mode () + (interactive) + (unless (and (eq last-command 'my-buffer-create-or-cycle-same-mode) + (= 1 (prefix-numeric-value last-prefix-arg))) + (setq my-buffers-same-mode + (seq-filter 'my-buffer-with-same-major-mode-p (buffer-list)))) + (setq my-buffers-same-mode + (my-list-cycle my-buffers-same-mode)) + (switch-to-buffer (car my-buffers-same-mode))) + +(defun my-buffer-create-or-cycle-same-mode (&optional arg) + "Create or switch to a buffer of the same major mode + +No prefix: cycle +One prefix: switch to buffer with prompt by calling `my-buffers-major-mode' +Two prefixes: create a buffer by calling `my-buffer-create-same-mode' +" + (interactive "P") + (pcase (prefix-numeric-value arg) + (16 (my-buffer-create-same-mode)) + (4 (my-buffers-major-mode)) + (_ (my-buffer-cycle-same-mode)))) + +(defun my-copy-buffer-file-name () + (interactive) + (when buffer-file-name) + (kill-new (abbreviate-file-name buffer-file-name)) + (message "Copied %s" (abbreviate-file-name buffer-file-name))) + +;;;###autoload +(defun my-kill-buffer (&optional arg) + "Kill current buffer. +With optional prefix ARG (\\[universal-argument]) choose which +buffer to kill." + (interactive "P") + (let ((kill-buffer-query-functions nil)) + (if arg + (call-interactively 'kill-buffer) + (kill-buffer)))) + +;;;###autoload +(defun my-rename-file-and-buffer (name) + "Apply NAME to current file and rename its buffer. +Do not try to make a new directory or anything fancy." + (interactive + (list (read-file-name "Rename current file: " (buffer-file-name)))) + (let ((file (buffer-file-name))) + (if (vc-registered file) + (vc-rename-file file name) + (rename-file file name)) + (set-visited-file-name name t t))) + +(defun my--buffer-vc-root-prompt () + "Prompt of `my-buffers-vc-root'." + (let ((root (expand-file-name + (or (vc-root-dir) + (locate-dominating-file "." ".git")))) + (read-buffer-function nil)) + (read-buffer + (format "Buffers in %s: " root) + nil t + (lambda (pair) ; pair is (name-string . buffer-object) + (with-current-buffer (cdr pair) + (string-match-p root default-directory)))))) + +;;; from prot-emacs +;;;###autoload +(defun my-buffers-vc-root () + "Select buffer matching the current one's VC root." + (interactive) + (switch-to-buffer (my--buffer-vc-root-prompt))) + +(defun my-bookmark-save-no-prompt (&rest _) + "Run `bookmark-save' without prompts. + +The intent of this function is to be added as an :after advice to +`bookmark-set-internal'. Concretely, this means that when +`bookmark-set-internal' is called, this function is called right +afterwards. We set this up because there is no hook after +setting a bookmark and we want to automatically save bookmarks at +that point." + (funcall 'bookmark-save)) + +(defun my-cycle-windows () + "Cycle all windows." + (interactive) + (let* ((windows (window-list nil 0)) + (first-window (pop windows)) + (buffer (window-buffer first-window)) + (temp-buffer) + (window)) + (when windows (select-window (car windows))) + (dolist (window windows) + (setq temp-buffer (window-buffer window)) + (set-window-buffer window buffer) + (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." + (interactive) + (delete-other-windows) + (let ((margin (/ (- (window-width) 80) 2))) + (set-window-margins nil margin margin))) + +(defun my-select-new-window-matching-mode (mode) + "Select a new window." + (setq available-windows + (delete (selected-window) (window-list))) + (setq new-window + (or (cl-find-if (lambda (window) + (equal (my-get-major-mode-for-buffer + (window-buffer window)) + mode)) + available-windows) + (car available-windows) + (split-window-sensibly) + (split-window-right))) + (select-window new-window)) + +(defun my-toggle-lock-current-window-to-buffer () + (interactive) + (my-toggle-lock-window-to-buffer (selected-window))) + +(defun my-toggle-lock-window-to-buffer (window) + (if (window-dedicated-p window) + (progn (set-window-dedicated-p window nil) + (message "Window unlocked.")) + (set-window-dedicated-p window t) + (message "Window locked."))) + +;; https://lists.gnu.org/archive/html/help-gnu-emacs/2010-01/msg00058.html +(defun my-increase-default-face-height (&optional steps) + "Increase the height of the default face by STEPS steps. + Each step multiplies the height by 1.2; a negative number of steps + decreases the height by the same amount." + (interactive + (list + (cond ((eq current-prefix-arg '-) -1) + ((numberp current-prefix-arg) current-prefix-arg) + ((consp current-prefix-arg) -1) + (t 1)))) + (let ((frame (selected-frame))) + (set-face-attribute 'default frame + :height (floor + (* (face-attribute 'default :height frame) + (expt 1.05 steps)))))) + +(defun my-decrease-default-face-height (&optional steps) + "Decrease the height of the default face by STEPS steps. + Each step divides the height by 1.2; a negative number of steps + increases the height by the same amount." + (interactive + (list + (cond ((eq current-prefix-arg '-) -1) + ((numberp current-prefix-arg) current-prefix-arg) + ((consp current-prefix-arg) -1) + (t 1)))) + (my-increase-default-face-height (- steps))) + +;; if file link points to the same file, do not open in other window +(defun my-find-file-maybe-other-window (filename) + (if (equal buffer-file-name (expand-file-name filename)) + (find-file filename) + (find-file-other-window filename))) + +(defun my-buffer-empty-p () + "Test whether the buffer is empty." + (or (= (point-min) (point-max)) + (save-excursion + (goto-char (point-min)) + (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$") + (zerop (forward-line 1)))) + (eobp)))) + +;;;; Scratch buffers +;; The idea is based on the `scratch.el' package by Ian Eure: +;; <https://github.com/ieure/scratch-el>. + +(defun my-buffer-scratch-list-modes () + "List known major modes." + (cl-loop for sym symbols of obarray + when (and (functionp sym) + (or (provided-mode-derived-p sym 'text-mode) + (provided-mode-derived-p sym 'prog-mode))) + collect sym)) + +(defun my-buffer-scratch-setup (region &optional mode) + "Add contents to `scratch' buffer and name it accordingly. + +REGION is added to the contents to the new buffer. + +Use the current buffer's major mode by default. With optional +MODE use that major mode instead." + (unless (provided-mode-derived-p mode 'text-mode 'prog-mode) + (error "Cannot create a scratch with %s which is not derived from +text- or prog-mode." mode)) + (let* ((major (or mode major-mode)) + (string (format "Scratch buffer for: %s\n\n" major)) + (text (concat string region)) + (buf (format "*%s scratch*" major))) + (with-current-buffer (pop-to-buffer buf) + (funcall major) + (if (my-buffer-empty-p) + ;; We could use `save-restriction' for narrowed buffers, but + ;; it is overkill. + (progn + (insert text) + (goto-char (point-min)) + (comment-region (line-beginning-position) (line-end-position)) + (goto-char (point-max))) + (goto-char (point-max)) + (when (my-line-regexp-p 'non-empty) + (insert "\n\n")) + (insert region))))) + +;;;###autoload +(defun my-buffer-create-scratch (&optional arg) + "Produce a scratch buffer matching the current major mode. + +With optional ARG as a prefix argument (\\[universal-argument]), +use `my-scratch-buffer-default-mode'. + +With ARG as a double prefix argument, prompt for a major mode +with completion. Candidates are derivatives of `text-mode' or +`prog-mode'. + +If region is active, copy its contents to the new scratch +buffer. + +Buffers are named as *MAJOR-MODE scratch*. If one already exists +for the given MAJOR-MODE, any text is appended to it." + (interactive "P") + (let* ((default-mode my-scratch-buffer-default-mode) + (modes (my-buffer-scratch-list-modes)) + (region (with-current-buffer (current-buffer) + (if (region-active-p) + (buffer-substring-no-properties + (region-beginning) + (region-end)) + ""))) + mode) + (pcase (prefix-numeric-value arg) + (16 (progn + (setq mode (intern (completing-read "Select major mode: " modes nil t))) + (my-buffer-scratch-setup region mode))) + (4 (my-buffer-scratch-setup region default-mode)) + (_ (my-buffer-scratch-setup region))))) + +(defcustom my-scratch-buffer-default-mode 'org-mode + "Default major mode for `my-buffer-create-scratch'." + :type 'symbol + :group 'my) + +(defun my-base-buffer (&optional buffer) + "Get the base buffer of BUFFER." + (setq buffer (or buffer (current-buffer))) + (unless (bufferp buffer) (error "Not a buffer.")) + (or (buffer-base-buffer buffer) buffer)) + +(defun my-buffer-with-same-base-p (other-buffer &optional buffer) + "Test that buffer has the same base buffer as the current buffer." + (equal (my-base-buffer other-buffer) + (my-base-buffer buffer))) + +(defun my-switch-indirect-buffer () + (interactive) + (let* ((current (current-buffer)) + (buffer + (read-buffer "Switch to indirect buffer: " nil t + (lambda (buffer) + (and + (my-buffer-with-same-base-p + (cdr buffer) current) + (not (equal (cdr buffer) current))))))) + (switch-to-buffer buffer))) + +(defun my-list-cycle (xs) + "Cycle a list." + (cdr (append xs (list (car xs))))) + +(defvar my-indirect-buffer-list nil) + +(defun my-cycle-indirect-buffer () + (interactive) + (unless (and (eq last-command 'my-create-or-switch-indirect-buffers) + (= 1 (prefix-numeric-value last-prefix-arg))) + (setq my-indirect-buffer-list + (seq-filter 'my-buffer-with-same-base-p (buffer-list)))) + (setq my-indirect-buffer-list + (my-list-cycle my-indirect-buffer-list)) + (switch-to-buffer (car my-indirect-buffer-list))) + +(defun my-create-or-switch-indirect-buffers (arg) + "Create or switch to an indirect buffer of the current buffer. + +With no prefix, cycle through indirect buffers. + +With optional ARG as a prefix argument (\\[universal-argument]), +prompt for indirect buffer to choose from. + +With double prefix arguments, create a new indirect buffer." + (interactive "P") + (pcase (prefix-numeric-value arg) + (16 (clone-indirect-buffer nil t)) + (4 (my-switch-indirect-buffer)) + (_ (my-cycle-indirect-buffer)))) + +(provide 'my-buffer) +;;; my-buffer.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-calibre.el b/emacs/.emacs.d/lisp/my/my-calibre.el new file mode 100644 index 0000000..e12028b --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-calibre.el @@ -0,0 +1,83 @@ +;;; my-calibre.el -- Calibre client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Calibre client. + +;;; Code: + + +(defun org-attach-calibre-book (id) + "Attach a calibre book with ID to the current org entry." + (interactive "sCalibre book id: ") + (let ((export-dir (org-attach-dir t) + )) + (call-process-shell-command + (format "mkdir -p %s && calibredb export --dont-asciiize \\ + --replace-whitespace --single-dir --to-dir %s %s" export-dir export-dir id) + nil "*calibredb*") + (org-attach-sync))) + +;; the following should be adapted to a capture so that one can fix anything +;; erroneous before refiling and attaching +;; fixme: the following should be decoupled from org maybe +(defun create-calibre-book-node (id) + (interactive "sCalibre book ID: ") + ;; 1. get book metadata from calibredb + ;; 1.1. run calibredb to get metadata + (ignore-errors (kill-buffer "*calibredb*")) + (if (= 0 + (call-process-shell-command + (concat "calibredb show_metadata " id) nil "*calibredb*")) + ;; 1.2. parse the metadata to get author, title and year + (let ((book-info (my-parse-colon-separated-output "*calibredb*"))) + ;; 2. create the node and attach it under books and papers + ;; 2.1 create a new node + (kill-buffer "*calibredb*") + (org-capture nil "book") + (insert (format + "%s - %s - [%s]" + (let ((full-author (alist-get "Authors" book-info nil nil 'string=))) + ;; (pp book-info) + (substring full-author + (1+ (string-match "\\[.*\\]" full-author)) + (1- (match-end 0)))) + (alist-get "Title" book-info nil nil 'string=) + (substring (alist-get "Published" book-info nil nil 'string=) 0 10))) + ;; 2.2 use org-entry-put to add all the properties + (dolist (pair book-info) + (org-entry-put (point-min) (car pair) (cdr pair))) + (attach-calibre-book id)) + (error (format "Cannot find book %s!" id)))) + +(defun my-calibredb-search (query) + (interactive "scalibredb search query: ") + (ignore-errors (kill-buffer "*calibredb*")) + (call-process-shell-command + (format "calibredb search %s | xargs -d, -i sh -c 'echo ID: {} && calibredb show_metadata {}'" query) + nil "*calibredb*") + (switch-to-buffer "*calibredb*")) + +(provide 'my-calibre) +;;; my-calibre.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-complete.el b/emacs/.emacs.d/lisp/my/my-complete.el new file mode 100644 index 0000000..61ee31a --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-complete.el @@ -0,0 +1,56 @@ +;;; my-complete.el -- Completion related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Completion related extensions for emacs core. Covering minibuffer, +;; icomplete, recentf etc. + +;;; Code: + + +;;; icomplete +;; FIXME: do we still need these? +(defun my-icomplete-vertical-forward-page () + "Forward page in icomplete." + (interactive) + (dotimes (_ (1- (window-total-height))) (icomplete-forward-completions))) + +(defun my-icomplete-vertical-backward-page () + "Backward page in icomplete." + (interactive) + (dotimes (_ (1- (window-total-height))) (icomplete-backward-completions))) + +;;; recentf +(defun my-recentf-save-list-silently () + (interactive) + (let ((inhibit-message t)) + (recentf-save-list))) + +(defun my-recentf-add-all-open-buffers () + (interactive) + (dolist (buffer (buffer-list)) + (when-let ((filename (buffer-file-name buffer))) + (recentf-add-file filename)))) + +(provide 'my-complete) +;;; my-complete.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-consult.el b/emacs/.emacs.d/lisp/my/my-consult.el new file mode 100644 index 0000000..bf3e385 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-consult.el @@ -0,0 +1,35 @@ +;;; my-consult.el -- Extensions for consult -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for consult. + +;;; Code: + +(defun my-consult-grep-default () + "Like `consult-grep', but grepping the default directory." + (interactive) + (consult-grep default-directory nil)) + +(provide 'my-consult) +;;; my-consult.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-corfu.el b/emacs/.emacs.d/lisp/my/my-corfu.el new file mode 100644 index 0000000..191f513 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-corfu.el @@ -0,0 +1,39 @@ +;;; my-corfu.el -- Extensions for corfu -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for corfu. + +;;; Code: + +;; Adapted from Corfu's manual. +(defun my-corfu-enable-always-in-minibuffer () + "Enable Corfu in the minibuffer if icomplete is not active. +Useful for prompts such as `eval-expression' and `shell-command'." + (unless (bound-and-true-p icomplete--initial-input) + (corfu-mode 1))) + +(provide 'my-corfu) +;;; my-corfu.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-detached.el b/emacs/.emacs.d/lisp/my/my-detached.el new file mode 100644 index 0000000..39d3085 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-detached.el @@ -0,0 +1,40 @@ +;;; my-detached.el -- Extensions for detached -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for detached. + +;;; Code: + + +(require 'detached) + +(defun my-execute-external-command (command) + (interactive + (list + (completing-read + "External command: " (my-external-command-collection)))) + (detached-shell-command command)) + +(provide 'my-detached) +;;; my-detached.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-dired.el b/emacs/.emacs.d/lisp/my/my-dired.el new file mode 100644 index 0000000..21240e1 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-dired.el @@ -0,0 +1,109 @@ +;;; my-dired.el -- Extension for dired -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extension for dired. + +;;; Code: + + +(require 'my-utils) + +(defvar my-dired-reverse-sorting nil) + +(defun my-dired-find-or-alternate (arg) + "Find if file, alternate find if dir. +If prefix then xdg-open, dir or file." + (interactive "P") + (if arg (call-process "xdg-open" nil 0 nil (dired-get-filename nil t)) + (if (file-directory-p (dired-get-filename nil t)) + (dired-find-alternate-file) + (dired-find-file)))) + +(defun my-dired-do-rename-and-symlink-back (arg) + (interactive "P") + (dired-do-create-files 'move-and-symlink #'my-rename-and-symlink-back + "Move and symlink back" arg dired-keep-marker-rename + "Rename and symlink")) + +(defun my-dired-sort-by-size () + (interactive) + (setq dired-actual-switches + (concat dired-listing-switches " -S" + (when my-dired-reverse-sorting "r"))) + (revert-buffer) + (setq mode-name "Dired by size")) + +(defun my-dired-sort-by-time () + (interactive) + (setq dired-actual-switches + (concat dired-listing-switches " -t" + (when my-dired-reverse-sorting "r"))) + (revert-buffer) + (setq mode-name "Dired by time")) + +(defun my-dired-sort-by-extension () + (interactive) + (setq dired-actual-switches + ;; FIXME: reverse sorting not working + (concat dired-listing-switches " -X" + (when my-dired-reverse-sorting "r"))) + (revert-buffer) + (setq mode-name "Dired by extension")) + +(defun my-dired-sort-by-name () + (interactive) + (setq dired-actual-switches + (concat dired-listing-switches + (when my-dired-reverse-sorting " -r"))) + (revert-buffer) + (setq mode-name "Dired by name")) + +(defun my-dired-toggle-sorting (arg) + "Cycle dired sorting methods. + +With a prefix arg, toggle `my-dired-reverse-sorting' instead." + (interactive "P") + (if arg + (progn + (setq my-dired-reverse-sorting + (not my-dired-reverse-sorting)) + (cond ((equal mode-name "Dired by name") + (my-dired-sort-by-name)) + ((equal mode-name "Dired by time") + (my-dired-sort-by-time)) + ((equal mode-name "Dired by size") + (my-dired-sort-by-size)) + ((equal mode-name "Dired by extension") + (my-dired-sort-by-extension)))) + (cond ((equal mode-name "Dired by name") + (my-dired-sort-by-time)) + ((equal mode-name "Dired by time") + (my-dired-sort-by-size)) + ((equal mode-name "Dired by size") + (my-dired-sort-by-extension)) + ((equal mode-name "Dired by extension") + (my-dired-sort-by-name))))) + +(provide 'my-dired) +;;; my-dired.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-editing.el b/emacs/.emacs.d/lisp/my/my-editing.el new file mode 100644 index 0000000..bd3ca83 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-editing.el @@ -0,0 +1,340 @@ +;;; my-editing.el -- Editing related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Stefan Monnier <monnier@iro.umontreal.ca> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Editing related extensions. + +;;; Code: + + + +;;; Some of the following functions are adapted from prot-dotfiles +(defun my-comment-and-copy-selection () + (interactive) + (comment-dwim nil) + (my-yank-primary)) + +(defun my-kill-region-if-active (beg end &optional region) + (interactive (list (mark) (point) 'region)) + (when mark-active + (kill-region beg end region))) + +;;; Stefan Monnier <foo at acm.org>. It is the opposite of fill-paragraph +(defun my-unfill-paragraph (&optional region) + "Takes a multi-line paragraph and makes it into a single line of text." + (interactive (progn (barf-if-buffer-read-only) '(t))) + (let ((fill-column (point-max)) + ;; This would override `fill-column' if it's an integer. + (emacs-lisp-docstring-fill-column t)) + (fill-paragraph nil region))) + +;;; fixme: move to search +(defun my-replace-leading-space (to-string begin end) + (interactive (list (read-string "Replace leading whitespace by: ") + (region-beginning) (region-end))) + (save-excursion + (goto-char begin) + (while (re-search-forward "^\\ +" end t) + (replace-match to-string)))) + +(defun my-concat-lines (begin end) + (interactive (list (region-beginning) (region-end))) + (replace-regexp "\n" " " nil begin end)) + +(defun my-save-without-formatting () + (interactive) + (read-only-mode 1) + (save-buffer) + (read-only-mode -1)) + +(defun my-yank-primary () + (interactive) + (let ((primary (gui-get-primary-selection))) + (push-mark) + (insert-for-yank primary))) + +(defun my-beginning-of-line-or-indentation () + "Move to beginning of line, or indentation" + (interactive) + (if (bolp) + (back-to-indentation) + (beginning-of-line))) + +(defun my-copy-url-at-point () + (interactive) + (when-let ((url (thing-at-point-url-at-point))) + (kill-new url) + (message "Copied: %s" (thing-at-point-url-at-point)))) + +(defun my-backward-kill-path-component () + (interactive) + (zap-up-to-char -1 ?/)) + +(defun my-toggle-forward-word-viper-symbol () + (interactive) + (require 'viper) + (cond ((eq (lookup-key (current-global-map) "\M-f") 'forward-word) + (progn + (define-key global-map "\M-f" 'viper-forward-word) + (define-key global-map "\M-b" 'viper-backward-word) + (message "M-f is viper-forward-word"))) + ((eq (lookup-key (current-global-map) "\M-f") 'viper-forward-word) + (progn + (define-key global-map "\M-f" 'forward-symbol) + (define-key global-map "\M-b" + (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"))))) + +(defun my-kill-line-backward () + "Kill from point to the beginning of the line." + (interactive) + (kill-line 0)) + +(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 +inserting the substring." + (save-excursion + (goto-char end) + (insert (buffer-substring-no-properties beg end)) + (when indent + (indent-for-tab-command)))) + +;;;###autoload +(defun my-copy-line-or-region (&optional duplicate) + "Copy the current line or active region to the `kill-ring'. +With optional DUPLICATE as a prefix argument, duplicate the +current line or active region without adding it to the `kill-ring'." + (interactive "P") + (let* ((region (region-active-p)) + (beg (if region (region-beginning) (line-beginning-position))) + (end (if region (region-end) (1+ (line-end-position)))) + (message (if region "region" "line"))) + (if duplicate + (my--duplicate-buffer-substring beg end) + (copy-region-as-kill beg end) + (message "Copied current %s" message)))) + +;;;###autoload +(defun my-new-line-below (&optional arg) + "Create an empty line below the current one. +Move the point to the absolute beginning. Adapt indentation by +passing optional prefix ARG (\\[universal-argument]). Also see +`my-new-line-above'." + (interactive "P") + (end-of-line) + (if arg + (newline-and-indent) + (newline))) + +;;;###autoload +(defun my-new-line-above-or-below (&optional arg) + "Create an empty line above the current one. +Move the point to the absolute beginning. Open a new line below +by passing optional prefix ARG (\\[universal-argument])." + (interactive "P") + (if arg + (my-new-line-below) + (if (or (bobp) + (line-number-at-pos (point-min))) + (progn + (beginning-of-line) + (newline) + (forward-line -1)) + (forward-line -1) + (my-new-line-below)))) + +(defun my--pos-url-on-line (&optional char) + "Return position of `my-url-regexp' on line or at CHAR." + (save-excursion + (goto-char (or char (line-beginning-position))) + (re-search-forward my-url-regexp (line-end-position) :noerror))) + +;;;###autoload +(defun my-escape-url-line (&optional char) + "Escape all URLs or email addresses on the current line. +By default, start operating from `line-beginning-position' to the +end of the current line. With optional CHAR as a buffer +position, operate from CHAR to the end of the line." + (interactive) + (when-let ((regexp-end (my--pos-url-on-line char))) + (save-excursion + (goto-char regexp-end) + (unless (looking-at ">") + (insert ">") + (search-backward "\s") + (forward-char 1) + (insert "<"))) + (my-escape-url-line (1+ regexp-end)))) + +;; Thanks to Bruno Boal for `my-escape-url-region'. I am +;; just renaming it for consistency with the rest of prot-simple.el. +;; Check Bruno's Emacs config: <https://github.com/BBoal/emacs-config>. + +;;;###autoload +(defun my-escape-url-region (&optional beg end) + "Apply `my-escape-url-line' on region lines between BEG and END." + (interactive + (if (region-active-p) + (list (region-beginning) (region-end)) + (error "There is no region!"))) + (unless (> end beg) + (cl-rotatef end beg)) + (save-excursion + (goto-char beg) + (setq beg (line-beginning-position)) + (while (<= beg end) + (my-escape-url-line beg) + (beginning-of-line 2) + (setq beg (point))))) + +;;;###autoload +(defun my-escape-url-dwim () + "Escape URL on the current line or lines implied by the active region. +Call the commands `my-escape-url-line' and +`my-escape-url-region' ." + (interactive) + (call-interactively + (if (region-active-p) + #'my-escape-url-region + #'my-escape-url-line))) + +;; Got those numbers from `string-to-char' +(defcustom my-insert-pair-alist + '(("' Single quote" . (39 39)) ; ' ' + ("\" Double quotes" . (34 34)) ; " " + ("` Elisp quote" . (96 39)) ; ` ' + ("‘ Single apostrophe" . (8216 8217)) ; ‘ ’ + ("“ Double apostrophes" . (8220 8221)) ; “ ” + ("( Parentheses" . (40 41)) ; ( ) + ("{ Curly brackets" . (123 125)) ; { } + ("[ Square brackets" . (91 93)) ; [ ] + ("< Angled brackets" . (60 62)) ; < > + ("« Εισαγωγικά Gr quote" . (171 187)) ; « » + ("= Equals signs" . (61 61)) ; = = + ("~ Tilde" . (126 126)) ; ~ ~ + ("* Asterisks" . (42 42)) ; * * + ("/ Forward Slash" . (47 47)) ; / / + ("_ underscores" . (95 95))) ; _ _ + "Alist of pairs for use with `my-insert-pair-completion'." + :type 'alist + :group 'my-editing) + +(defvar my--character-hist '() + "History of inputs for `my-insert-pair-completion'.") + +(defun my--character-prompt (chars) + "Helper of `my-insert-pair-completion' to read CHARS." + (let ((def (car my--character-hist))) + (completing-read + (format "Select character [%s]: " def) + chars nil t nil 'my--character-hist def))) + +;;;###autoload +(defun my-insert-pair (pair &optional count) + "Insert PAIR from `my-insert-pair-alist'. +Operate on the symbol at point. If the region is active, use it +instead. + +With optional COUNT (either as a natural number from Lisp or a +universal prefix argument (\\[universal-argument]) when used +interactively) prompt for the number of delimiters to insert." + (interactive + (list + (my--character-prompt my-insert-pair-alist) + current-prefix-arg)) + (let* ((data my-insert-pair-alist) + (left (cadr (assoc pair data))) + (right (caddr (assoc pair data))) + (n (cond + ((and count (natnump count)) + count) + (count + (read-number "How many delimiters?" 2)) + (1))) + (beg) + (end) + (forward)) + (cond + ((region-active-p) + (setq beg (region-beginning) + end (region-end))) + ((when (thing-at-point 'symbol) + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (setq beg (car bounds) + end (cdr bounds))))) + (t (setq beg (point) + end (point) + forward t))) + (save-excursion + (goto-char end) + (dotimes (_ n) + (insert right)) + (goto-char beg) + (dotimes (_ n) + (insert left))) + (when forward (forward-char n)))) + +;;;###autoload +(defun my-delete-pair-dwim () + "Delete pair following or preceding point. +For Emacs version 28 or higher, the feedback's delay is +controlled by `delete-pair-blink-delay'." + (interactive) + (if (eq (point) (cdr (bounds-of-thing-at-point 'sexp))) + (delete-pair -1) + (delete-pair 1))) + +;;;###autoload +(defun my-zap-back-to-char (char &optional arg) + "Backward `zap-to-char' for CHAR. +Optional ARG is a numeric prefix to match ARGth occurance of +CHAR." + (interactive + (list + (read-char-from-minibuffer "Zap to char: " nil 'read-char-history) + (prefix-numeric-value current-prefix-arg))) + (zap-to-char (- arg) char)) + +(defun my-transpose-lines () + "Same as `transpose-lines' but move point to the original position + +Basically move the line up +" + (interactive) + (let ((line (current-line)) + (col (current-column))) + (call-interactively 'transpose-lines) + (goto-line line) + (forward-char col))) + +(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 new file mode 100644 index 0000000..dadbb55 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-emms.el @@ -0,0 +1,454 @@ +;;; my-emms.el -- Extensions for emms -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for emms. + +;;; Code: + + + +;;; emms +(require 'emms-playlist-mode) +(require 'my-buffer) +(defun my-emms-switch-to-playlist-buffer () + (interactive) + (my-switch-to-buffer-matching-major-mode 'emms-playlist-mode)) + +(require 'emms-player-mpv) +(defun my-emms-mpv-toggle-video () + (interactive) + (if (member "--no-video" emms-player-mpv-parameters) + (progn + (setq emms-player-mpv-parameters + (remove "--no-video" emms-player-mpv-parameters)) + (message "emms: video enabled!")) + (setq emms-player-mpv-parameters + (nconc emms-player-mpv-parameters '("--no-video"))) + (message "emms: video disabled!"))) + +(require 'emms) +(defun my-emms-mpv-toggle-torsocks () + (interactive) + (emms-pause) + (if (string= "torsocks" emms-player-mpv-command-name) + (progn + (setq emms-player-mpv-command-name (pop emms-player-mpv-parameters)) + (message "Will run mpv without torsocks. Please restart mpv.")) + (push emms-player-mpv-command-name emms-player-mpv-parameters) + (setq emms-player-mpv-command-name "torsocks") + (message "Will run mpv with torsocks. Please restart mpv"))) + +;;; do we need this? doesn't emms already have something like this? +(defmacro my-with-current-buffer-as-current-emms-playlist (&rest body) + "Run BODY with the current playlist buffer being the current buffer." + `(let ((saved-buffer emms-playlist-buffer)) + (my-emms-playlist-mode-make-current) + ,@body + (emms-playlist-set-playlist-buffer saved-buffer))) + +(defun my-emms-playlist-save-current-buffer () + (interactive) + (when (equal major-mode 'emms-playlist-mode) + (my-with-current-buffer-as-current-emms-playlist + (call-interactively 'emms-playlist-save)))) + +(defun my-emms-maybe-seek-to-last-played () + (when-let ((last-playing-time + (emms-track-get (emms-playlist-current-selected-track) + 'playing-time))) + (emms-seek-to last-playing-time))) + +;;; do we need this? +(defun my-emms-playlist-mode-make-current () + "make the current playlist buffer current" + (interactive) + (when (equal major-mode 'emms-playlist-mode) + (emms-playlist-set-playlist-buffer (current-buffer)) + (when (called-interactively-p 'interactive) + (message "%s is the current playlist buffer." + emms-playlist-buffer)))) + +;; mode line and playing time go together +(defun my-emms-mode-line-enable () + (interactive) + (emms-mode-line-mode 1) + (emms-playing-time-enable-display)) + +(defun my-emms-mode-line-disable () + (interactive) + (emms-mode-line-mode -1) + (emms-playing-time-disable-display)) + +(defun my-emms-mode-line-toggle () + (interactive) + (emms-mode-line-mode 'toggle) + (emms-playing-time-display-mode 'toggle)) + +(defvar my-emms-native-playlists + (directory-files emms-source-file-default-directory t "\\.native$")) + +(defun my-emms-playlist-make-buffer-name (playlist) + "Make an emms buffer name from a playlist file name." + (concat "emms-" (file-name-base playlist))) + +(defun my-emms-load-from-native (playlist &optional buffer-name) + "Creates an emms playlist buffer with BUFFER-NAME from a native PLAYLIST." + (unless buffer-name (setq buffer-name (my-emms-playlist-make-buffer-name playlist))) + (let ((saved-buffer emms-playlist-buffer)) + (with-current-buffer + (or (get-buffer buffer-name) + (emms-playlist-new buffer-name)) + (my-emms-playlist-mode-make-current) + (emms-playlist-clear) + (emms-add-native-playlist playlist) + (message (format "%s loaded in buffer %s!" + playlist buffer-name))) + (and saved-buffer (emms-playlist-set-playlist-buffer saved-buffer)))) + +(defun my-emms-add-all () + (interactive) + (mapc 'my-emms-load-from-native my-emms-native-playlists) + (emms-metaplaylist-mode-go)) + +(defun my-emms-deduplicate () + (interactive) + (emms-mark-regexp ".* ([0-9])\\.[a-zA-Z0-9]+" nil) + (emms-mark-delete-marked-tracks)) + +(defun my-emms-reload (from to type) + "Reload playlist buffer TO from files of url lists + +The content of a file in FROM is a list of urls. TYPE is +either 'audio or 'video +" + (interactive) + (when (memq (get-buffer to) emms-playlist-buffers) + (emms-playlist-set-playlist-buffer to) + (with-current-buffer to (emms-playlist-clear)) + (let ((emms-track-initialize-functions nil)) + (my-emms-add-url-lists from + (alist-get type my-extension-types))) + (with-current-buffer to (emms-sort)))) + +(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. +'source is a list of files of url lists. +'type is one of 'audio, 'video, or 'audiovideo") + +(defun my-emms-playlist-reload-current () + "Reload the current playlist using info from `my-emms-playlist-alist'" + (interactive) + (let* ((name (buffer-name emms-playlist-buffer)) + (info (alist-get name my-emms-playlist-alist nil nil #'equal))) + (my-emms-reload (alist-get 'source info) name (alist-get 'type info)))) + +(defun my-emms-save-all () + (interactive) + (let ((saved-buffer emms-playlist-buffer) + (saved-overwrite emms-source-playlist-ask-before-overwrite)) + (setq emms-source-playlist-ask-before-overwrite nil) + (dolist (pair my-emms-native-playlists) + (let ((file (car pair)) + (buffer (cadr pair))) + (when (get-buffer buffer) + (with-current-buffer buffer + (my-emms-playlist-mode-make-current) + (emms-playlist-save 'native file))))) + (emms-playlist-set-playlist-buffer saved-buffer) + (setq emms-source-playlist-ask-before-overwrite saved-overwrite))) + +(defun my-emms-add-process-output-url (process output) + "A process filter extracting url from a jq output." + (let ((left (string-match "\".*\"" output))) + (emms-add-url (substring output (1+ left) (1- (match-end 0)))))) + +(defun my-emms-add-ytdl-playlist (url buffer-name) + "Adds all videos on a web playlist from URL using ytdl. + +URL could be link to a playlist, a playlist id, videos of a channel, or a + list of playlists on a channel +" + (interactive "syoutube-dl playlist url: \nsemms buffer name: ") + (unless (get-buffer buffer-name) + (emms-playlist-new buffer-name)) + (emms-playlist-set-playlist-buffer buffer-name) + (set-process-filter + (start-process-shell-command + "ytdl-emms" nil + (format "yt-dlp -j %s | jq '.webpage_url'" url)) + 'my-emms-add-process-output-url)) + +(defvar my-ytdl-supported-domains + '("youtu.be" "youtube.com" "yewtu.be" "framatube.org" "pbs.org" "v.redd.it" + "soundcloud.com")) + +(defvar my-ytdl-supported-domains-re + (string-join my-ytdl-supported-domains "\\|")) + +(defvar my-emms-incoming-playlists + '((audio . "emms-incoming-audios") + (video . "emms-incoming-videos") + (nil . "emms-incoming")) + "EMMS playlists to insert incoming items.") + +(defun my-emms-enqueue-buffer-ytdl-incoming (media-type) + (let ((current-emms-buffer emms-playlist-buffer) + (links (link-gopher-get-all-links-in-buffer my-ytdl-supported-domains-re))) + (with-current-buffer (alist-get media-type my-emms-incoming-playlists) + (my-emms-playlist-mode-make-current) + (dolist (url links) + (emms-add-url url))) + (with-current-buffer current-emms-buffer + (my-emms-playlist-mode-make-current)))) + +(defun my-emms-playlist-set-info-title-at-point (title) + (when (equal major-mode 'emms-playlist-mode) + (let ((track (get-text-property (point) 'emms-track))) + (emms-track-set track 'info-title title)))) + +(defun my-emms-add-url-region (from to &optional filter-exts) + "Adds a list of urls to emms separated by newlines. + +filter extensions from filter-exts." + (interactive (list (region-beginning) (region-end))) + (mapc 'emms-add-url + (seq-filter + (lambda (s) (and + (not (equal s "")) + (or (not filter-exts) + (member + (when (string-match "^.*\\.\\(.*\\)$" s) + (match-string 1 s)) + filter-exts)))) + (split-string + (buffer-substring-no-properties from to) " +")))) + +(defun my-emms-add-url-list (file) + (interactive (list (read-file-name "Add url list from file: "))) + (with-temp-buffer + (let ((coding-system-for-read 'utf-8)) + (find-file file)) + (my-emms-add-url-region (point-min) (point-max)))) + +(defun my-emms-add-url-lists (files &optional filter-exts) + (with-temp-buffer + (let ((coding-system-for-read 'utf-8)) + (mapc 'insert-file-contents (reverse files))) + (my-emms-add-url-region (point-min) (point-max) filter-exts))) + +(defun my-emms-ytdl-current-buffer-command () + (interactive) + (let ((results)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (push (format "'%s'" (alist-get 'name (emms-playlist-track-at (point)))) + results) + (beginning-of-line 2))) + (kill-new (concat "torsocks yt-dlp -w -x -o \"%(title)s.%(ext)s\" " + (string-join (reverse results) " "))) + (message "Copied yt-dlp command of downloading %d urls to the kill ring" + (length results)))) + +;; TODO: use emms-playlist-current-selected-track instead +(defun my-emms-get-current-track () + (with-current-buffer emms-playlist-buffer + (emms-playlist-mode-center-current) + (emms-playlist-track-at (point)))) + +(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) + (or (alist-get 'info-title track) + (when-let ((name + (alist-get 'name 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)))) + (with-temp-buffer + (when current-track (insert current-track)) + (let ((inhibit-message t)) + (write-file my-emms-i3bar-file))))) +(defun my-emms-output-current-track-to-i3bar-file-no-error () + (ignore-error (my-emms-output-current-track-to-i3bar-file))) + +(defun my-emms-get-current-track-name () + (emms-track-get (my-emms-get-current-track) 'name)) + +(defun my-emms-print-current-track-display-name () + (interactive) + (with-current-buffer emms-playlist-buffer + (emms-playlist-mode-center-current) + (message (my-get-current-line-no-properties)))) + +(defun my-emms-print-current-track-name () + (interactive) + (message + (concat "current track: " + (my-emms-get-current-track-name)))) + +(defun my-emms-playlist-kill-track-name-at-point () + (interactive) + (let ((name (emms-track-get (emms-playlist-track-at (point)) 'name))) + (kill-new name) + (message "Copied %s" name))) + +(defun my-emms-kill-current-track-name () + (interactive) + (let ((name (my-emms-get-current-track-name))) + (kill-new name) + (message "Copied %s" name))) + +(defvar my-emms-favourites-playlist + (file-name-concat emms-directory "favourites.native")) +(defun my-emms-append-current-track-to-favourites () + (interactive) + (with-temp-buffer + (find-file my-emms-favourites-playlist) + (goto-char (1+ (point-min))) + (beginning-of-line 3) + (insert (prin1-to-string (my-emms-get-current-track))) + (insert "\n") + (save-buffer) + (message "Added %s to %s!" + (my-emms-print-current-track-display-name) + my-emms-favourites-playlist) + (kill-buffer)) + (my-emms-load-from-native my-emms-favourites-playlist + (my-emms-playlist-make-buffer-name + my-emms-favourites-playlist))) + +;;; random album in emms +(defun my-my-emms-current-album-name () + (file-name-directory (my-emms-get-current-track-name))) + +(defun my-emms-next-track-or-random-album () + (interactive) + (let ((current-album (my-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) + (emms-start) + (my-emms-random-album nil)))) + +(defvar-local my-emms-albums-cache (vector)) + +(defun my-emms-save-albums-cache () + (let ((album-set (make-hash-table :test 'equal)) + (album-list)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (puthash (file-name-directory + (emms-track-get (emms-playlist-track-at (point)) 'name)) + nil album-set) + (forward-line))) + (maphash (lambda (key _) (push key album-list)) album-set) + (setq my-emms-albums-cache (vconcat album-list)) + (message "Emms album cache updated."))) + +(defun my-emms-random-album (update-album) + (interactive "P") + (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 + (elt my-emms-albums-cache (random (length my-emms-albums-cache))) + nil t) + (emms-playlist-mode-play-current-track) + (goto-char saved-position) + (error "Cannot play random album"))))) + +;;; override the minor mode +;;;###autoload +(define-minor-mode emms-playing-time-display-mode + "Minor mode to display playing time on mode line." + :global t + ;; When disabling the mode, don't disable `emms-playing-time-display-mode' + ;; since that may be used by other packages. + ) + +;; do we really need this? emms already has some dired support builtin +(require 'dired) +(defun my-dired-add-to-emms () + (interactive) + (let ((target (dired-get-filename))) + (or (emms-add-file target) (emms-add-directory target)))) + +(defun my-emms-playlist-delete-at-point () + (interactive) + (let* ((track (emms-playlist-track-at (point))) + (type (emms-track-type track)) + (name (emms-track-name track))) + (cond ((and (eq type 'url) + (string-match "^file://\\(.*\\)" name)) + (let ((file-name (match-string 1 name))) + (when (and + (not (file-attribute-type (file-attributes file-name))) + (y-or-n-p (format "Delete file %s?" file-name))) + (delete-file file-name) + (message "File deleted: %s" name) + (emms-playlist-mode-kill-track)))) + (t (message "cannot delete %s" name))))) + +;; wip +(defun emms-download-at-point (audio-only) + (interactive "P") + (let* ((track (emms-playlist-track-at (point))) + (type (emms-track-get track 'type)) + (url (emms-track-get track 'name))) + (cond + ((not (equal type 'url)) + (error "Not a url type track!")) + ((not (or (string-prefix-p "http://" url) + (string-prefix-p "https://" url))) + (error "Not http(s) scheme!")) + (t (my-shell-with-directory "~/Downloads"))) + )) + +;; Used to override `emms-track-simple-description' to fallback to description +(defun my-emms-track-simple-description (track) + "Simple function to give a user-readable description of a track. +If it's a file track, just return the file name. Otherwise, +return the type and the name with a colon in between. +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)) + ((eq 'url type) + (emms-format-url-track-name (emms-track-name track))) + (t (concat (symbol-name type) + ": " (emms-track-name track)))))) + +(provide 'my-emms) +;;; my-emms.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-github.el b/emacs/.emacs.d/lisp/my/my-github.el new file mode 100644 index 0000000..7dc2248 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-github.el @@ -0,0 +1,68 @@ +;;; my-github.el -- Github client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Github client. + +;;; Code: + + +(defun my-grok-github (url) + "get github info of a project. +url is the url of the project +License; name; description; homepage; created at" + (when (string-match "github.com\\(/[^/]+/[^/]+\\)/?.*$" url) + (with-current-buffer (url-retrieve-synchronously + (concat "https://api.github.com/repos" + (replace-regexp-in-string + "\\.git$" "" (match-string 1 url)))) + (set-buffer-multibyte t) + (my-delete-http-header) + (my-grok-github-make-info (json-read))))) + +(defun my-post-process-licensing-name (name) + (cond ((equal name "MIT") "expat") + (t name))) + +(defun my-grok-github-make-info (raw) + (list (cons "Title" (alist-get 'name raw)) + (cons "Description" (alist-get 'description raw)) + (cons "Source" (alist-get 'html_url raw)) + (cons "Website" (alist-get 'homepage raw)) + (cons "Released" (substring (alist-get 'created_at raw) 0 10)) + (cons "Pushed" (substring (alist-get 'pushed_at raw) 0 10)) + (cons "Subject" (string-join (alist-get 'topics raw) ", ")) + ;; FIXME: why did we comment this out? + ;; (cons "License" (my-post-process-licensing-name + ;; (alist-get 'spdx_id (alist-get 'license raw)))) + (cons "Developers" (my-grok-github-get-developer-name + (alist-get 'url (alist-get 'owner raw)))))) + +(defun my-grok-github-get-developer-name (url) + (with-current-buffer (url-retrieve-synchronously url) + (set-buffer-multibyte t) + (my-delete-http-header) + (alist-get 'name (json-read)))) + +(provide 'my-github) +;;; my-github.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-gitlab.el b/emacs/.emacs.d/lisp/my/my-gitlab.el new file mode 100644 index 0000000..a25533f --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-gitlab.el @@ -0,0 +1,61 @@ +;;; my-gitlab.el -- gitlab client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; gitlab client. + +;;; Code: + + +(defun my-get-gitlab-project-id (url) + (with-current-buffer (url-retrieve-synchronously + (replace-regexp-in-string "\\.git$" "" url)) + (goto-char (point-min)) + (when (re-search-forward "Project ID: \\([0-9]+\\)" nil t) + (match-string 1)))) + +(defun my-grok-gitlab (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))))) + +(defun my-grok-gitlab-make-info (raw) + (list (cons "Title" (alist-get 'name raw)) + (cons "Description" (my-clean-property-value + (alist-get 'description raw))) + (cons "Source" (alist-get 'web_url raw)) + (cons "Subject" (string-join + (alist-get 'tag_list raw) ", ")) + (cons "Released" (substring (alist-get 'created_at raw) 0 10)) + (cons "Last-activity" (substring + (alist-get 'last_activity_at raw) 0 10)) + (cons "Developers" (alist-get 'name (alist-get 'namespace raw))))) + +(provide 'my-gitlab) +;;; my-gitlab.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el new file mode 100644 index 0000000..aee03b5 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-gnus.el @@ -0,0 +1,327 @@ +;;; my-gnus.el -- Email related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Email related extensions for emacs core. Covers gnus, message mode etc. + +;;; Code: + + + +(defun my-gnus-summary-exit-like-mu4e () (interactive) + (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer)) + (gnus-summary-expand-window) + (gnus-summary-exit))) + +(defun my-gnus-summary-next-article-like-mu4e () (interactive) + (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer)) + (gnus-summary-next-article) + (next-line))) +(defun my-gnus-summary-prev-article-like-mu4e () (interactive) + (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer)) + (gnus-summary-prev-article) + (previous-line))) + +(defun my-gnus-topic-select-group (arg) + (interactive "P") + (if arg (gnus-topic-select-group t) + (gnus-topic-select-group 200))) + +(defun my-gnus-move-article-like-mu4e () + (interactive) + (call-interactively 'gnus-summary-move-article) + (my-gnus-summary-next-article-like-mu4e)) + +(defvar my-gnus-group-default-targets + '((archive . "Archive") (trash . "Trash"))) + +(defvar my-gnus-group-alist `((".*" . ,my-gnus-group-default-targets)) + "Alist of information about groups such as archive and trash +targets. Later entries override earlier ones") + +(defun my-gnus-refile-article-like-mu4e (key) + "Refile an article and move to the next, just like in mu4e. + +The archiving target comes from `my-gnus-group-alist'. +KEY is either 'archive or 'trash." + (interactive) + (let ((target + (alist-get key my-gnus-group-default-targets)) + (new-group-name)) + (pcase-dolist (`(,re . ,info) my-gnus-group-alist) + (when (and (string-match re gnus-newsgroup-name) + (alist-get key info)) + (setq target (alist-get key info)))) + (setq new-group-name + (replace-regexp-in-string + "/.*" + (concat "/" target) + gnus-newsgroup-name)) + (gnus-summary-move-article 1 new-group-name) + (my-gnus-summary-next-article-like-mu4e))) + +(defun my-gnus-archive-article-like-mu4e () + "Archive an article and move to the next, just like in mu4e. + +The archiving target comes from `my-gnus-group-alist'." + (interactive) + (my-gnus-refile-article-like-mu4e 'archive)) + +(defun my-gnus-trash-article-like-mu4e () + (interactive) + (my-gnus-refile-article-like-mu4e 'trash)) + +(defun my-org-open-gnus-link (link) + (my-select-new-window-matching-mode 'gnus-summary-mode) + (org-gnus-open link t)) + +(defvar my-gnus-inbox-group nil + "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)) + +(defun my-gnus-start () + (interactive) + (let ((buffer (get-buffer "*Group*"))) + (if buffer + (switch-to-buffer "*Group*") + (gnus)))) + +(defun my-gnus-topic-up () + (interactive) + (gnus-topic-jump-to-topic (gnus-current-topic))) + +(defun my-gnus-group-compose () + (interactive) (gnus-group-mail '(4))) + +(defun my-gnus-group-get-new-news-quietly () + (interactive) + (let ((inhibit-message t)) + (gnus-group-get-new-news))) + + +;; override `mm-display-external' +;; Removed the following nonsensical part +;; ;; So that we pop back to the right place, sort of. +;; (switch-to-buffer gnus-summary-buffer) +(defun my-mm-display-external (handle method) + "Display HANDLE using METHOD." + (let ((outbuf (current-buffer))) + (mm-with-unibyte-buffer + (if (functionp method) + (let ((cur (current-buffer))) + (if (eq method 'mailcap-save-binary-file) + (progn + (set-buffer (generate-new-buffer " *mm*")) + (setq method nil)) + (mm-insert-part handle) + (mm-add-meta-html-tag handle) + (let ((win (get-buffer-window cur t))) + (when win + (select-window win))) + (switch-to-buffer (generate-new-buffer " *mm*"))) + (buffer-disable-undo) + (set-buffer-file-coding-system mm-binary-coding-system) + (insert-buffer-substring cur) + (goto-char (point-min)) + (when method + (message "Viewing with %s" method)) + (let ((mm (current-buffer)) + (attachment-filename (mm-handle-filename handle)) + (non-viewer (assq 'non-viewer + (mailcap-mime-info + (mm-handle-media-type handle) t)))) + (unwind-protect + (if method + (progn + (when (and (boundp 'gnus-summary-buffer) + (buffer-live-p gnus-summary-buffer)) + (when attachment-filename + (with-current-buffer mm + (rename-buffer + (format "*mm* %s" attachment-filename) t))) + ;; ;; So that we pop back to the right place, sort of. + ;; (switch-to-buffer gnus-summary-buffer) + (switch-to-buffer mm)) + (funcall method)) + (mm-save-part handle)) + (when (and (not non-viewer) + method) + (mm-handle-set-undisplayer handle mm))))) + ;; The function is a string to be executed. + (mm-insert-part handle) + (mm-add-meta-html-tag handle) + ;; We create a private sub-directory where we store our files. + (let* ((dir (with-file-modes #o700 + (make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir))) + (filename (or + (mail-content-type-get + (mm-handle-disposition handle) 'filename) + (mail-content-type-get + (mm-handle-type handle) 'name))) + (mime-info (mailcap-mime-info + (mm-handle-media-type handle) t)) + (needsterm (or (assoc "needsterm" mime-info) + (assoc "needsterminal" mime-info))) + (copiousoutput (assoc "copiousoutput" mime-info)) + file buffer) + (if filename + (setq file (expand-file-name + (gnus-map-function mm-file-name-rewrite-functions + (file-name-nondirectory filename)) + dir)) + ;; Use nametemplate (defined in RFC1524) if it is specified + ;; in mailcap. + (let ((suffix (cdr (assoc "nametemplate" mime-info)))) + (if (and suffix + (string-match "\\`%s\\(\\..+\\)\\'" suffix)) + (setq suffix (match-string 1 suffix)) + ;; Otherwise, use a suffix according to + ;; `mailcap-mime-extensions'. + (setq suffix (car (rassoc (mm-handle-media-type handle) + mailcap-mime-extensions)))) + (setq file (with-file-modes #o600 + (make-temp-file (expand-file-name "mm." dir) + nil suffix))))) + (let ((coding-system-for-write mm-binary-coding-system)) + (write-region (point-min) (point-max) file nil 'nomesg)) + ;; The file is deleted after the viewer exists. If the users edits + ;; the file, changes will be lost. Set file to read-only to make it + ;; clear. + (set-file-modes file #o400 'nofollow) + (message "Viewing with %s" method) + (cond + (needsterm + (let ((command (mm-mailcap-command + method file (mm-handle-type handle)))) + (unwind-protect + (if window-system + (set-process-sentinel + (start-process "*display*" nil + mm-external-terminal-program + "-e" shell-file-name + shell-command-switch command) + (lambda (process _state) + (if (eq 'exit (process-status process)) + (run-at-time + 60.0 nil + (lambda () + (ignore-errors (delete-file file)) + (ignore-errors (delete-directory + (file-name-directory + file)))))))) + (require 'term) + (require 'gnus-win) + (set-buffer + (setq buffer + (make-term "display" + shell-file-name + nil + shell-command-switch command))) + (term-mode) + (term-char-mode) + (set-process-sentinel + (get-buffer-process buffer) + (let ((wc gnus-current-window-configuration)) + (lambda (process _state) + (when (eq 'exit (process-status process)) + (ignore-errors (delete-file file)) + (ignore-errors + (delete-directory (file-name-directory file))) + (gnus-configure-windows wc))))) + (gnus-configure-windows 'display-term)) + (mm-handle-set-external-undisplayer handle (cons file buffer)) + (add-to-list 'mm-temp-files-to-be-deleted file t)) + (message "Displaying %s..." command)) + 'external) + (copiousoutput + (with-current-buffer outbuf + (forward-line 1) + (mm-insert-inline + handle + (unwind-protect + (progn + (call-process shell-file-name nil + (setq buffer + (generate-new-buffer " *mm*")) + nil + shell-command-switch + (mm-mailcap-command + method file (mm-handle-type handle))) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (buffer-string)))) + (progn + (ignore-errors (delete-file file)) + (ignore-errors (delete-directory + (file-name-directory file))) + (ignore-errors (kill-buffer buffer)))))) + 'inline) + (t + ;; Deleting the temp file should be postponed for some wrappers, + ;; shell scripts, and so on, which might exit right after having + ;; started a viewer command as a background job. + (let ((command (mm-mailcap-command + method file (mm-handle-type handle)))) + (unwind-protect + (let ((process-connection-type nil)) + (start-process "*display*" + (setq buffer + (generate-new-buffer " *mm*")) + shell-file-name + shell-command-switch command) + (set-process-sentinel + (get-buffer-process buffer) + (lambda (process _state) + (when (eq (process-status process) 'exit) + (run-at-time + 60.0 nil + (lambda () + (ignore-errors (delete-file file)) + (ignore-errors (delete-directory + (file-name-directory file))))) + (when (buffer-live-p outbuf) + (with-current-buffer outbuf + (let ((buffer-read-only nil) + (point (point))) + (forward-line 2) + (let ((start (point))) + (mm-insert-inline + handle (with-current-buffer buffer + (buffer-string))) + (put-text-property start (point) + 'face 'mm-command-output)) + (goto-char point)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))) + (message "Displaying %s...done" command)))) + (mm-handle-set-external-undisplayer + handle (cons file buffer)) + (add-to-list 'mm-temp-files-to-be-deleted file t)) + (message "Displaying %s..." command)) + 'external))))))) + +(provide 'my-gnus) +;;; my-gnus.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-grep.el b/emacs/.emacs.d/lisp/my/my-grep.el new file mode 100644 index 0000000..324e44d --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-grep.el @@ -0,0 +1,48 @@ +;;; my-grep.el -- Extensions for grep -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for grep. + +;;; Code: + + + +(defun my-grep-focus-buffer (buffer) + (pop-to-buffer buffer)) + +(defun my-rgrep-at-directory (dir) + (my-with-default-directory dir + (let* ((regexp (grep-read-regexp)) + (files (grep-read-files regexp))) + (rgrep regexp files dir)))) + +(defun my-grep-docs (project regexp) + (interactive (list (completing-read "Docs to grep: " + (my-get-list-of-docs)) + (grep-read-regexp))) + (rgrep regexp (alist-get "docs" grep-files-aliases nil nil 'string=) + (concat my-docs-root-dir "/" project))) + +(provide 'my-grep) +;;; my-grep.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-help.el b/emacs/.emacs.d/lisp/my/my-help.el new file mode 100644 index 0000000..27c23ce --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-help.el @@ -0,0 +1,138 @@ +;;; my-help.el -- Help related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Emacs help related extensions. + +;;; Code: + + +;; find source of external command +(defun my-external-command-open-source (command) + (interactive + (list (completing-read + "Open source of command: " + (my-external-command-collection)))) + (let ((subject + (cadr + (split-string (my-shell-command-output + (format "type %s" command)) + " is ")))) + (pcase subject + ("a shell builtin" (error "%s is %s" command subject)) + ("a shell keyword" (error "%s is %s" command subject)) + ((guard (string-prefix-p "is aliased to " subject)) + (substring subject (error "%s is %s" command subject))) + (_ + (pcase-let + ((`(,path ,type) + (split-string + (my-shell-command-output (format "file -Li %s" subject)) + ": "))) + (if (string-prefix-p "text/" type) + (progn + (message "Opening %s" path) + (find-file path)) + (error "%s (%s) is not plaintext: %s" command path type))))))) + +(defun my-external-command-collection () + (mapcan + (lambda (dir) + (mapcar + (lambda (file) + (string-match "\\(?:.*\\)/\\(.*\\)" file) + (match-string 1 file)) + (seq-filter + (lambda (file) + (and (not (file-directory-p file)) + (file-executable-p file))) + (directory-files dir t "[^~#]$")))) + (seq-filter + 'file-accessible-directory-p + (exec-path)))) + +(defun my-woman-man (arg) + (interactive "P") + (if arg (call-interactively 'man) + (call-interactively 'woman))) + +(defun my-help-goto-symbol (symbol) + (interactive + ;; copied from prompt code of help-describe-symbol + (let* ((v-or-f (symbol-at-point)) + (found (if v-or-f (cl-some (lambda (x) (funcall (nth 1 x) v-or-f)) + describe-symbol-backends))) + (v-or-f (if found v-or-f (function-called-at-point))) + (found (or found v-or-f)) + (enable-recursive-minibuffers t) + (val (completing-read (format-prompt "Describe symbol" + (and found v-or-f)) + #'help--symbol-completion-table + (lambda (vv) + (cl-some (lambda (x) (funcall (nth 1 x) vv)) + describe-symbol-backends)) + t nil nil + (if found (symbol-name v-or-f))))) + (list (if (equal val "") + (or v-or-f "") (intern val))))) + (help-do-xref nil #'describe-symbol (list symbol))) + +(defun my-describe-local-variable (variable &optional buffer frame) + (interactive + (let ((v (variable-at-point)) + (enable-recursive-minibuffers t) + (orig-buffer (current-buffer)) + val) + (setq val (completing-read + (format-prompt "Describe variable" (and (symbolp v) v)) + #'help--symbol-completion-table + (lambda (vv) + (and (local-variable-p vv) + (or (get vv 'variable-documentation) + (and (not (keywordp vv)) + ;; Since the variable may only exist in the + ;; original buffer, we have to look for it + ;; there. + (buffer-local-boundp vv orig-buffer))))) + t nil nil + (if (symbolp v) (symbol-name v)))) + (list (if (equal val "") + v (intern val))))) + (describe-variable variable buffer frame)) + +(defun my-info-display-manual () + (interactive) + (call-interactively 'info-display-manual) + (when (derived-mode-p 'Info-mode) + (rename-buffer + (generate-new-buffer-name + (format "*info %s*" + (file-name-sans-extension + (file-name-nondirectory Info-current-file))))))) + +(defun my-describe-symbol-at-point () + (interactive) + (describe-symbol (symbol-at-point))) + +(provide 'my-help) +;;; my-help.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-hiedb.el b/emacs/.emacs.d/lisp/my/my-hiedb.el new file mode 100644 index 0000000..ef3a3c4 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-hiedb.el @@ -0,0 +1,73 @@ +;;; my-hiedb.el -- Extensions for hiedb -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for hiedb. + +;;; Code: + +;;; to use, do for example: +;; (add-hook 'haskell-mode-hook +;; (lambda () +;; (add-hook 'xref-backend-functions +;; #'hiedb--xref-backend nil t))) + +(defun hiedb--xref-backend () 'hiedb) + +(cl-defmethod xref-backend-definitions + ((_backend (eql hiedb)) _identifiers) + (my-hiedb-call-point-defs buffer-file-name + (1+ (current-line)) (1+ (current-column))) + (my-hiedb-parse-point-defs-output + (file-name-directory buffer-file-name) + (with-current-buffer "*hiedb*" + (goto-char (point-min)) (kill-line) (kill-line) + (buffer-string)) + )) + +(defun my-hiedb-call-point-defs (file line col) + (let ((dir (file-name-directory file)) + (module-name (file-name-base file))) + (with-current-buffer (get-buffer-create "*hiedb*") + (erase-buffer)) + (call-process "hiedb" nil "*hiedb*" nil + "-D" + (format "%sdefault.hiedb" dir) + "point-defs" module-name + (number-to-string line) + (number-to-string col)))) + +(defun my-hiedb-parse-point-defs-output (dir output) + "module-name:line-begin:col-begin-line-end:col-end" + (pcase-let ((`(,module-name ,line-beg ,col-beg, line-end, col-end) + (split-string output "[:-]" (print output)))) + (list + (xref-make-match + "" (xref-make-file-location + (format "%s%s.hs" dir module-name) + (string-to-number line-beg) + (string-to-number col-beg)) + (- (string-to-number col-end) (string-to-number col-beg)))))) + +(provide 'my-hiedb) +;;; my-hiedb.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-hnreader.el b/emacs/.emacs.d/lisp/my/my-hnreader.el new file mode 100644 index 0000000..4176f8b --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-hnreader.el @@ -0,0 +1,106 @@ +;;; my-hnreader.el -- Extensions to hnreader -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Thanh Vuong <thanhvg@gmail.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions to hnreader. + +;;; Code: + +;; To override `hnreader--print-frontpage-item' +(defun my-hnreader--print-frontpage-item (thing subtext) + "Print THING dom and SUBTEXT dom." + (let* ((url (format "https://news.ycombinator.com/item?id=%s" (dom-attr thing 'id))) + (a-node (dom-child-by-tag (dom-by-class thing "^titleline$") 'a)) + (title-link (dom-attr a-node 'href))) + (insert (format "\n* %s [[%s][%s]] (%s) [[elisp:(hnreader-comment \"%s\")][%s]]" + ;; rank + (dom-text (dom-by-class thing "^rank$")) + title-link + ;; title + (dom-text a-node) + ;; points + (dom-text (dom-by-class subtext "^score$")) + ;; comments + url + (dom-text (last (dom-by-tag subtext 'a))))) + )) + + +;; To override `hnreader--print-frontpage' +(defun my-hnreader--print-frontpage (dom buf url) + "Print raw DOM and URL on BUF." + (let ((things (dom-by-class dom "^athing$")) + (subtexts (dom-by-class dom "^subtext$"))) + (with-current-buffer buf + (read-only-mode -1) + (erase-buffer) + (insert "#+STARTUP: overview indent\n") + (hnreader--print-header) + (insert (hnreader--get-route-top-info dom)) + (cl-mapcar #'hnreader--print-frontpage-item things subtexts) + ;; (setq-local org-confirm-elisp-link-function nil) + (if hnreader--history + (insert "\n* "(format "[[elisp:(hnreader-back)][< Back]]" ) " | ") + (insert "\n* ")) + (insert (hnreader--get-morelink dom) " | ") + (insert (format "[[elisp:(hnreader-read-page-back \"%s\")][Reload]]" url) ) + (org-mode) + (goto-char (point-min)) + (forward-line 2)))) + +;; To override `hnreader--print-comments' +(defun my-hnreader--print-comments (dom url) + "Print DOM comment and URL to buffer." + (let ((comments (dom-by-class dom "^athing comtr$")) + (title (hnreader--get-title dom)) + (info (hnreader--get-post-info dom)) + (more-link (dom-by-class dom "morelink"))) + (with-current-buffer (hnreader--get-hn-comment-buffer) + (read-only-mode -1) + (erase-buffer) + (insert "-*-Org-*-\n") + (insert "#+TITLE: " (car title)) + (insert (format "\n%s\n" (cdr title))) + (insert (car info)) + (when (cdr info) + (insert "\n") + (shr-insert-document (cdr info))) + (dolist (comment comments) + (insert (format "%s %s\n" + (hnreader--get-indent + (hnreader--get-img-tag-width comment)) + (hnreader--get-comment-owner comment))) + (shr-insert-document (hnreader--get-comment comment))) + (when more-link + (insert "\n* " (format "[[elisp:(hnreader-comment \"%s\")][More]]" (concat "https://news.ycombinator.com/" + (dom-attr more-link 'href))))) + (insert "\n* " (format "[[elisp:(hnreader-comment \"%s\")][Reload]]" url)) + (org-mode) + ;; (org-shifttab 3) + (goto-char (point-min)) + (forward-line 2)))) + +(provide 'my-hnreader) +;;; my-hnreader.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-libgen.el b/emacs/.emacs.d/lisp/my/my-libgen.el new file mode 100644 index 0000000..98ea409 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-libgen.el @@ -0,0 +1,241 @@ +;;; my-libgen.el -- libgen client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; libgen client. + +;;; Code: + + +;;; todo: autoloads +(require 'link-gopher) +(require 'my-wget) +(require 'my-utils) + +(defvar my-libgen-hosts nil "Hosts of standard libgen") + +(defvar my-libgen-alt-hosts nil "Hosts of libgen variants") + +(defvar my-libgen-library-hosts nil "Hosts of libgen library sites") + +(defvar my-libgen-host nil) +(defvar my-libgen-library-host nil) + +(defun my-libgen-set-random-hosts () + "Randomly set `my-libgen-host' and `my-libgen-library-host'" + (setq my-libgen-library-host + (my-seq-random-element my-libgen-library-hosts) + my-libgen-host + (my-seq-random-element my-libgen-hosts))) + +(defun my-libgen-get-download-url (md5-or-url) + (cond ((string-match "://.*/fiction/\\(.*\\)$" md5-or-url) + (concat my-libgen-library-host "/fiction/" + (match-string 1 md5-or-url))) + ((string-match "\\?md5=\\(.*\\)$" md5-or-url) + (concat my-libgen-library-host "/main/" + (match-string 1 md5-or-url))) + ;; defaults to libgen + ((string-match "\\([0-9A-F]\\{32\\}\\)" md5-or-url) + (concat my-libgen-library-host "/main/" + (match-string 1 md5-or-url))))) + +;; TODO: this function looks more general than libgen +(defun my-libgen-url-at-point () + (or (get-text-property (point) 'shr-url) + (thing-at-point-url-at-point))) + +(defun my-libgen-get-filename-from-ipfs-url (url) + (string-match "filename=\\(.*\\)$" link) + (decode-coding-string (url-unhex-string (match-string 1 link)) 'utf-8)) + +(defun my-libgen-wget (md5-or-url) + (interactive (list (read-string "MD5 or URL: " + (my-libgen-url-at-point)))) + (when-let ((link (car (link-gopher-get-all-links + (my-libgen-get-download-url md5-or-url) + "\\.\\(epub\\|pdf\\|djvu\\)$")))) + (wget link))) + +(defun my-libgen-api-by-isbn (isbn) + (my-url-fetch-json + (format "%s/json.php?object=e&isbn=%s&fields=*" + my-libgen-host isbn))) + +(defun my-libgen-format-result (info) + (concat + (propertize + (format + "%s %.1fM %s" + (my-libgen-format-filename info) + (/ (string-to-number (alist-get 'filesize info)) (* 1024.0 1024.0)) + (alist-get 'timelastmodified info)) + 'face 'button) + (propertize + (format + "\n\n%s" + (alist-get 'descr info)) + 'face 'default))) + +(defun my-libgen-api-by-id (id) + (my-url-fetch-json + (format "%s/json.php?object=e&ids=%s&fields=*" my-libgen-host id))) + +(defun my-grok-libgen-action (info) + (interactive) + (my-org-create-node + (my-grok-libgen-make-info + (elt + (my-libgen-api-by-id + (alist-get 'id info)) + 0)) + t)) + +(defun my-grok-libgen-make-info (info) + (list + (cons "libgen-id" (alist-get 'id info)) + (cons "Title" (alist-get 'title info)) + (cons "Authors" (alist-get 'author info)) + (cons "Published" (alist-get 'year info)) + (cons "Edition" (alist-get 'edition info)) + (cons "Publisher" (alist-get 'publisher info)) + (cons "Pages" (alist-get 'pages info)) + (cons "ISBN" (alist-get 'identifier info)) + (cons "Language" (alist-get 'language info)) + (cons "DOI" (alist-get 'doi info)) + (cons "OpenLibrary-ID" (alist-get 'openlibraryid info)) + (cons "Filesize" (alist-get 'filesize info)) + (cons "Extension" (alist-get 'extension info)) + (cons "md5" (alist-get 'md5 info)) + (cons "Description" (alist-get 'descr info)) + (cons "Cover" (format "%s/covers/%s" + my-libgen-host + (alist-get 'coverurl info))))) + +(defun my-libgen-format-filename (info) + (format + "%s - %s (%s) [%s].%s" + (alist-get 'author info) + (alist-get 'title info) + (alist-get 'year info) + (alist-get 'identifier info) + (alist-get 'extension info))) + +(defvar my-libgen-download-dir "~/Downloads") +(defun my-libgen-download-action () + (interactive) + (let ((info (get-text-property (point) 'button-data))) + (my-wget-async + (car (link-gopher-get-all-links + (format "/main/%s" my-libgen-library-host + (alist-get 'md5 info)) + (format "\\.%s$" (alist-get 'extension info)))) + (format "%s/%s" 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 "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)))) + +(defun my-libgen-search-isbn (isbn) + (interactive "sISBN: ") + (generic-search-open + (my-libgen-api-by-isbn isbn) + (format "libgen-isbn:%s" isbn) + `((formatter . my-libgen-format-result) + (default-action . my-grok-libgen-action) + (keymap . ,my-libgen-button-keymap)))) + +(defun my-libgen-search (query) + (interactive "sQuery: ") + (generic-search-open + (mapcar 'my-libgen-search-parse-tr + (cdddr + (dom-by-tag + (my-url-fetch-dom + (format "%s/search.php?req=%s&res=100" + my-libgen-host query)) + 'tr))) + (format "libgen-query:%s" query) + `((formatter . my-libgen-search-format-result) + (default-action . my-grok-libgen-action) + (keymap . ,my-libgen-button-keymap)))) + +(defun my-libgen-search-format-result (info) + (format + "%s [%s,%spp,%s,%s] %s" + (my-libgen-format-filename info) + (alist-get 'edition info) + (alist-get 'pages info) + (alist-get 'publisher info) + (alist-get 'language info) + (alist-get 'filesize-human info))) + +(defun my-libgen-search-parse-tr (tr) + (let* ((tds (dom-by-tag tr 'td)) + (id (dom-text (pop tds))) + (author (dom-texts (pop tds) "")) + (title-ed-id (car (last (dom-by-tag (pop tds) 'a)))) + (md5 (elt (split-string (or (dom-attr title-ed-id 'href) "") "=") 1)) + (title (string-trim (dom-text title-ed-id))) + (edition-id (mapconcat 'dom-texts (dom-by-tag title-ed-id 'font) "")) + (edition) + (identifier) + (publisher (dom-text (pop tds))) + (year (dom-text (pop tds))) + (pages (dom-text (pop tds))) + (language (dom-text (pop tds))) + (filesize-human (dom-text (pop tds))) + (extension (dom-text (pop tds))) + ) + (string-match "\\(?:\\[\\(.*\\)\\]\\)?\\([0-9].*\\)?" edition-id) + (setq edition (or (match-string 1 edition-id) "") + identifier (or (match-string 2 edition-id) "")) + `((id . ,id) + (author . ,author) + (md5 . ,md5) + (title . ,title) + (edition . ,edition) + (identifier . ,identifier) + (publisher . ,publisher) + (year . ,year) + (pages . ,pages) + (language . ,language) + (filesize-human . ,filesize-human) + (extension . ,extension)))) + +(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 new file mode 100644 index 0000000..779c7c7 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-magit.el @@ -0,0 +1,59 @@ +;;; my-magit.el -- Extensions for magit -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for magit. + +;;; Code: + + + +(require 'magit) +(require 'my-project) +(require 'org) + +(defun magit-clone-org-source (arg) + (interactive "P") + (let* ((url (org-entry-get (point) "Source")) + (default-base-dir + (alist-get "3p" my-projects-root-dirs nil nil 'string=)) + (default-name + (progn (string-match "^.*/\\(.*?\\)\\(\\.git\\)?$" url) + (match-string 1 url))) + (dir (read-file-name + (if arg "Clone to: " "Shallow clone to: ") + (concat default-base-dir "/") + nil nil + default-name))) + (if arg + (magit-clone-regular url dir nil) + (magit-clone-shallow url dir nil 1)) + (org-set-property "Local-source" + (format "<file:%s>" dir)))) + +(defun my-project-magit-at () + (interactive) + (magit-status (my-project-read-project-root))) + +(provide 'my-magit) +;;; my-magit.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-markdown.el b/emacs/.emacs.d/lisp/my/my-markdown.el new file mode 100644 index 0000000..8b12bc8 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-markdown.el @@ -0,0 +1,37 @@ +;;; my-markdown.el -- Extensions to markdown -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions to markdown. + +;;; Code: + +;;; markdown +(defun my-markdown-maybe-follow-thing-at-point (arg) + (interactive "P") + (condition-case nil + (markdown-follow-thing-at-point arg) + (user-error (newline)))) + +(provide 'my-markdown) +;;; my-markdown.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-markup.el b/emacs/.emacs.d/lisp/my/my-markup.el new file mode 100644 index 0000000..2b1c7f6 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-markup.el @@ -0,0 +1,68 @@ +;;; my-markup.el -- Markup related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Markup related extensions for emacs core. + +;;; Code: + + +;;; shr +(defun my-shr-add-id (dom start end) + (let ((id (dom-attr dom 'id))) + (when id + (put-text-property start end 'shr-frag-id id)))) + +(defun my-shr-add-id-advice (orig-fun &rest args) + (let ((start (point))) + (apply orig-fun args) + (my-shr-add-id (car args) start (point)))) + +;;; dom +(defun my-dom-remove-style (node) + (dolist (to-remove (dom-by-tag node 'style)) + (dom-remove-node node to-remove)) + node) +(defun my-dom-next-p-sibling (dom node) + "Return the next para sibling of NODE in DOM." + (when-let* ((parent (dom-parent dom node))) + (let ((siblings (dom-children parent)) + (next)) + (while (and siblings (not next)) + (when (eq (pop siblings) node) + (setq next (car siblings)))) + (while (and siblings (not (and (listp next) (eq (dom-tag next) 'p)))) + (setq next (pop siblings))) + next))) +(defun my-dom-first-tag-text (dom tag) + (car (dom-by-tag dom tag))) + +;; xml +(defun my-xml-get-first-child (node tag) + (car (xml-get-children node tag))) +(defun my-xml-get-first-child-text (node tag) + (when-let ((text (dom-text (my-xml-get-first-child node tag)))) + (replace-regexp-in-string "\n" " " (string-trim text)))) + +(provide 'my-markup) +;;; my-markup.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 new file mode 100644 index 0000000..0cef817 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-media-segment.el @@ -0,0 +1,182 @@ +;;; my-media-segment.el -- Media segmentation utility -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Media segmentation utility. + +;;; Code: + + + +;;; A utility using ffmpeg to cut a media file into smaller ones, from a +;;; description of the timestamps. +(defvar my-media-segment-queued-jobs nil) +(defvar my-media-segment-max-inflight 3) + +(defun my-media-segment-enqueue-process (start-process-function) + "Enqueue a process that can started by applying 'start-process'. + +The process can be started by applying 'start-process' on START-PROCESS-ARGS." + ;; somehow only this version works, but not nconc or setq with append + ;; the problem with the other two is that the operation gets stuck after the + ;; initial 'my-media-segment-max-inflight' operations. + (add-to-list 'my-media-segment-queued-jobs start-process-function) + ;; (nconc my-media-segment-queued-jobs (list start-process-function)) + ;; (setq my-media-segment-queued-jobs + ;; (append my-media-segment-queued-jobs (list start-process-function))) + ) + +(defun my-media-segment-dequeue-process () + (when my-media-segment-queued-jobs + (funcall (pop my-media-segment-queued-jobs)))) + +(defun my-segment-media-file-1 (media-file-name desc-file-name) + "Run ffmpeg asynchronously to segment file-name according to description. + +Uses `my-media-segment-max-inflight' to limit number of inflight tasks." + (interactive (list + (read-file-name "Choose media file: ") + (read-file-name "Choose description file: "))) + (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) + (info (my-get-media-segments + (with-temp-buffer + (insert-file-contents desc-file-name) + (buffer-string)))) + (total (length info)) + (idx 0) + (thunk)) + (dolist (media info) + (setq idx (1+ idx)) + (ignore-errors (dired-create-directory dir)) + (let* ((title (plist-get media :title)) + (start (plist-get media :start)) + (end (plist-get media :end)) + (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)))))) + (setq thunk + (lambda () + (message "Cutting %s-%s to %s (%d/%d)..." + start (or end "") title idx total) + (set-process-sentinel + (apply 'start-process + (append (list (format "ffmpeg-%s" title) + (format "*ffmpeg-%s*" title) + "ffmpeg") + args)) + (lambda (_ _) + (my-media-segment-dequeue-process))))) + (if (<= idx my-media-segment-max-inflight) + (funcall thunk) + (my-media-segment-enqueue-process thunk)))))) + +(defun my-get-media-segments (description) + "Output title start end triplets." + (let ((results) (title) (start) (end)) + (with-temp-buffer + (erase-buffer) + (insert description) + (goto-char (point-min)) + (save-excursion + (while (re-search-forward + "\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\(?:[[:space:]]*-[[:space:]]*\\(\\(?:[0-9]+:\\)?[0-9]+:[0-9]\\{2\\}\\)\\)?" + nil t) + (setq start (match-string-no-properties 1) + end (match-string-no-properties 2)) + (replace-match "") + (beginning-of-line 1) + (setq title (replace-regexp-in-string + "^[[:punct:][:space:]]*" "" + (replace-regexp-in-string + "[[:punct:][:space:]]*$" "" + (buffer-substring-no-properties + (point) + (progn (beginning-of-line 2) (point)))))) + (push (list :title (my-make-filename title) :start start :end end) results) + ) + (setq end nil) + (dolist (result results) + (unless (plist-get result :end) + (plist-put result :end end) + (setq end (plist-get result :start)))) + (reverse results)) + ))) + +(defvar my-segment-media-max-async 10) +(defun my-segment-media-file (media-file-name desc-file-name synchronously) + "Run ffmpeg asynchronously to segment file-name according to description. + +With a prefix-arg, run synchronously." + (interactive (list + (read-file-name "Choose media file: ") + (read-file-name "Choose description file: ") + current-prefix-arg)) + (let* ((dir (file-name-sans-extension (expand-file-name media-file-name))) + (info (my-get-media-segments + (with-temp-buffer + (insert-file-contents desc-file-name) + (buffer-string)))) + (total (length info)) + (idx 0)) + (when (or synchronously (<= total my-segment-media-max-async) + (let ((choice + (car + (read-multiple-choice + (format + "Recognised many (%d) segments, continue asynchronously?" + total) + '((?y "yes") + (?s "synchronously instead") + (?n "cancel")))))) + (cond ((eq choice ?y) t) + ((eq choice ?s) (setq synchronously t)) + (t nil)))) + (dolist (media info) + (setq idx (1+ idx)) + (ignore-errors (dired-create-directory dir)) + (let* ((title (plist-get media :title)) + (start (plist-get media :start)) + (end (plist-get media :end)) + (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)))))) + (message "Cutting %s-%s to %s (%d/%d)..." + start (or end "") title idx total) + (if synchronously + (apply 'call-process + (append (list "ffmpeg" nil "*ffmpeg*" t) args)) + (apply 'start-process + (append (list (format "ffmpeg-%s" title) + (format "*ffmpeg-%s*" title) + "ffmpeg") + args))))) + (when synchronously + (message "All %d segments splitted into %s" + (length info) dir))))) + +(provide 'my-media-segment) +;;; my-media-segment.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-net.el b/emacs/.emacs.d/lisp/my/my-net.el new file mode 100644 index 0000000..7713dba --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-net.el @@ -0,0 +1,113 @@ +;;; my-net.el -- Network related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Network related extensions for emacs core. + +;;; Code: + + +;;; net utilities +(defvar my-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))))))) + +(defun my-fetch-url (url) + (interactive "sURL: ") + (let ((file-name (expand-file-name (my-make-file-name-from-url url) + my-download-dir))) + (url-retrieve url 'my-fetch-url-save-and-switch (list file-name)))) + +(defun my-fetch-url-save-and-switch (status file-name) + (unless (plist-get status :error) + (my-delete-http-header) + (write-file file-name) + (let ((coding-system-for-read 'utf-8)) + (revert-buffer t t)) + (switch-to-buffer (current-buffer)))) + +(defun my-kill-http-header () + (my-skip-http-header) + (let ((killed (buffer-substring-no-properties (point-min) (point)))) + (delete-region (point-min) (point)) + killed)) + +(defun my-parse-http-header (text) + (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)))) + +(defvar my-client-buffer-name "*my-api*") + +(defun my-url-fetch-json (url &optional decompression with-header) + (my-url-fetch-internal + url + (lambda () + (json-read-from-string (decode-coding-string (buffer-string) 'utf-8))) + decompression + with-header)) + +(defun my-url-fetch-dom (url &optional decompression with-header) + (my-url-fetch-internal + url + (lambda () (libxml-parse-html-region (point) (point-max))) + 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)) + (insert "[" (current-time-string) "] Request: " url "\n")) + (with-current-buffer (url-retrieve-synchronously url t) + (let ((header (my-kill-http-header)) (status) (fields)) + (goto-char (point-min)) + (setq header (my-parse-http-header header) + status (alist-get 'status header) + fields (alist-get 'fields header)) + (with-current-buffer my-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))))))) + +(provide 'my-net) +;;; my-net.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-nov.el b/emacs/.emacs.d/lisp/my/my-nov.el new file mode 100644 index 0000000..863d09a --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-nov.el @@ -0,0 +1,56 @@ +;;; my-nov.el -- Extensions for nov.el -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for nov.el. + +;;; Code: + +(require 'nov) + +;; override nov-render-title +;; this is because header line does not work with follow mode +(defun my-nov-render-title (dom) + "Custom <title> rendering function for DOM. +Sets `header-line-format' to a combination of the EPUB title and +chapter title." + (let ((title (cdr (assq 'title nov-metadata))) + (chapter-title (car (esxml-node-children dom)))) + (when (not chapter-title) + (setq chapter-title "No title")) + ;; this shouldn't happen for properly authored EPUBs + (when (not title) + (setq title "No title")) + (setq mode-line-buffer-identification + (concat title ": " chapter-title)) + )) + +(defun my-nov-scroll-up (arg) + "Scroll with `scroll-up' or visit next chapter if at bottom." + (interactive "P") + (if (>= (follow-window-end) (point-max)) + (nov-next-document) + (follow-scroll-up arg))) + +(provide 'my-nov) +;;; my-nov.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-openlibrary.el b/emacs/.emacs.d/lisp/my/my-openlibrary.el new file mode 100644 index 0000000..559ecba --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-openlibrary.el @@ -0,0 +1,147 @@ +;;; my-openlibrary.el -- openlibrary client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; openlibrary client. + +;;; Code: + + +;;; an openlibrary client +(require 'generic-search) +(require 'my-net) + +(defvar my-openlibrary-host "https://openlibrary.org") +(defun my-openlibrary-api-book-by-olid (olid) + (my-url-fetch-json + (format "%s/api/books?bibkeys=OLID:%s&format=json&jscmd=data" + my-openlibrary-host olid))) + +(defun my-openlibrary-html-book-by-url (url) + (list + (cons 'description + (string-trim + (dom-texts + (dom-by-class + (my-url-fetch-dom url) + "book-description-content restricted-view")))))) + +(defun my-grok-openlibrary (url) + "grok openlibrary. +title, subtitle, description, subjects, authors (by_statement?), classification, publisher, publish_places, publish_date, subjects, cover" + (when (string-match + (concat my-openlibrary-host "/books/\\([^/]+\\)") url) + (my-grok-openlibrary-make-info + (append + (my-openlibrary-api-book-by-olid (match-string 1 url)) + (my-openlibrary-html-book-by-url url))))) + +(defun my-grok-openlibrary-make-info (info) + (list + (cons "Title" (alist-get 'title info)) + (cons "Subtitle" (alist-get 'subtitle info)) + (cons "Authors" (string-join + (mapcar (lambda (author) (alist-get 'name author)) + (alist-get 'authors info)) + ", ")) + (cons "Pages" + (when (alist-get 'number_of_pages info) + (number-to-string (alist-get 'number_of_pages info)))) + (cons "OpenLibrary-link" (alist-get 'url info)) + (cons "OpenLibrary-ID" (string-join (alist-get 'openlibrary info) ",")) + (cons "ISBN" (string-join + (vconcat + (alist-get 'isbn_13 + (alist-get 'identifiers info)) + (alist-get 'isbn_10 + (alist-get 'identifiers info))) + ", ")) + (cons "Dewey-Decimal" (alist-get 'dewey_decimal_class info)) + (cons "Subject" (string-join + (seq-take + (remove-duplicates + (mapcar (lambda (subject) (alist-get 'name subject)) + (alist-get 'subjects info)) + :test 'string=) + 20) + ", ")) + (cons "Cover" (alist-get 'large (alist-get 'cover info))) + (cons "Published" (alist-get 'publish_date info)) + (cons "Description" (alist-get 'description info)))) + +(defun my-openlibrary-api-book-by-isbn (isbn) + (my-url-fetch-json + (format + "%s/api/books?bibkeys=ISBN:%s&format=json&jscmd=data" + my-openlibrary-host isbn))) + +(defun my-grok-openlibrary-isbn (isbn) + (unless isbn (error "isbn not supplied")) + (let* ((info-json (alist-get (intern (format "ISBN:%s" isbn)) + (my-openlibrary-api-book-by-isbn isbn))) + (url (alist-get 'url info-json)) + (info-html (my-openlibrary-html-book-by-url url))) + (my-grok-openlibrary-make-info + (append info-json info-html)))) + +(defun my-openlibrary-api-search (query) + (my-url-fetch-json + (format "%s/search.json?q=%s" my-openlibrary-host query))) + +(defun my-openlibrary-format-result (info) + (format "%s - %s [%s] (%s)" + (string-join (alist-get 'author_name info) ", ") + (alist-get 'title info) + (string-join (alist-get 'isbn info) ",") + (alist-get 'publish_date info))) + +(defun my-openlibrary-action (info) + (interactive) + (my-org-create-node + (my-grok-openlibrary-isbn (elt (alist-get 'isbn info) 0)) + t)) + +(defun my-openlibrary-show-more-info () + (interactive) + (pp (my-grok-openlibrary-isbn + (elt + (alist-get 'isbn (get-text-property (point) 'button-data)) + 0)))) + +(defvar my-openlibrary-button-keymap + (let ((kmap (make-sparse-keymap))) + (set-keymap-parent kmap button-map) + (define-key kmap "p" 'my-openlibrary-show-more-info) + kmap)) + +(defun my-openlibrary-search (query) + (interactive "sQuery: ") + (generic-search-open + (alist-get 'docs (my-openlibrary-api-search query)) + (format "openlibrary-query:%s" query) + `((formatter . my-openlibrary-format-result) + (default-action . my-openlibrary-action) + (keymap . ,my-openlibrary-button-keymap)))) + +(provide 'my-openlibrary) +;;; my-openlibrary.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el new file mode 100644 index 0000000..cb72677 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-org.el @@ -0,0 +1,1003 @@ +;;; my-org.el -- Extensions for org -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for org. + +;;; Code: + + +(require 'org) + +;;; org mode +(defun my-org-open-shell-at-attach-dir () + (interactive) + (require 'my-prog) + (my-shell-with-directory (concat (org-attach-dir-get-create) "/"))) + +(defun my-org-links-in-entry () + "Get all link urls in an entry" + (save-excursion + (org-back-to-heading t) + (let (links + (end (save-excursion (outline-next-heading) (point)))) + (while (re-search-forward org-link-any-re end t) + (push + (org-unbracket-string "<" ">" + (or + ;; [[target][desc]] + (match-string-no-properties 2) + ;; plain link or <...> + (match-string-no-properties 0))) + links)) + links))) + +(defun my-org-http-s-links-in-entry () + "Get all http(s) urls in an entry" + (seq-filter (lambda (link) + (string-prefix-p + "http" + (progn (string-match org-link-types-re link) + (match-string 1 link)))) + (my-org-links-in-entry))) + +(defun my-org-insert-date-range (inactive) + "Insert two dates to form an active date range. + +With a prefix, insert inactive dates. +" + (interactive "P") + (org-time-stamp nil inactive) + (insert "--") + (org-time-stamp nil inactive)) + +(defun my-org-follow-link-after () + (when (eq major-mode 'mhtml-mode) + (browse-url-of-buffer))) + +;; navigation +(defun my-org-jump-to-last-visible-child () + "Goto the last visible child." + (interactive) + (let (level (pos (point)) (re org-outline-regexp-bol)) + (when (ignore-errors (org-back-to-heading t)) + (setq level (outline-level)) + (forward-char 1) + (while (and (re-search-forward re nil t) (> (outline-level) level)) + (when (and (= (outline-level) (1+ level)) + (not (get-char-property (point) 'invisible))) + (setq pos (match-beginning 0))))) + (goto-char pos))) + +(defun my-org-entry-toggle-drawer-visibility () + (interactive) + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (goto-char (point-min)) + (when (re-search-forward "^\\s-*:PROPERTIES:" nil t) + (org-hide-drawer-toggle))))) + +(defun my-org-open-default-notes-file () + (interactive) + (find-file org-default-notes-file)) + +;; links +(defun my-org-substitute-gnus-link-after-archiving () + "Fix a captured gnus article link after they've been archived" + (interactive) + (when (org-in-regexp org-link-bracket-re) + ;; We do have a link at point, and we are going to edit it. + (save-excursion + (let ((remove (list (match-beginning 0) (match-end 0))) + (desc (when (match-end 2) (match-string-no-properties 2))) + (link (match-string-no-properties 1)) + (target (alist-get 'archive my-gnus-group-default-targets))) + (pcase-dolist (`(,re . ,info) my-gnus-group-alist) + (when (and (string-match re link) + (alist-get 'archive info)) + (setq target (alist-get 'archive info)))) + (setq new-link + (replace-regexp-in-string "/.*?#" (format "/%s#" target) + link)) + (apply #'delete-region remove) + (insert (org-link-make-string new-link desc)) + (sit-for 0))))) + +;; editing heading +(defun my-org-orgzly-merge-link () + "Fixes orgzly entries with links separated from headlines. +Find the first link in the entry, and add that to the headline +title, and remove the body." + (interactive) + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (goto-char (point-min)) + (forward-line) + (when (re-search-forward org-link-any-re) + (let ((link (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (unused (replace-match "" nil)) + (desc (org-entry-get (point) "ITEM")) + (title-loc)) + (goto-char (point-min)) + (search-forward desc nil t) + (setq title-loc (match-beginning 0)) + (replace-match "" nil) + (while (search-forward desc nil t) (replace-match "" nil)) + (goto-char title-loc) + (insert (org-link-make-string link desc)))))) + (my-org-node-flush-empty-lines)) + +(defun my-org-node-flush-empty-lines () + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (flush-lines "^$")))) + +(defun my-org-element-contents-at-point () + (let ((element (org-element-at-point))) + (buffer-substring-no-properties + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + + +(defun my-org-append-subheading (arg) + "Append a subheading as a first child, or with an arg as a last child." + (interactive "P") + (if arg + (org-insert-subheading '(4)) + (let ((required-level (1+ (or (org-current-level) 0)))) + (org-show-children) + (org-next-visible-heading 1) + (org-insert-subheading nil) + (while (> (org-current-level) required-level) + (org-promote-subtree)) + (while (< (org-current-level) required-level) + (org-demote-subtree))))) + +;; copy a link +;;; fixme: do we still need this? +(defun my-org-copy-link-at-point () + (interactive) + (let ((link (my-org-link-at-point))) + (if link + (progn + (kill-new link) + (message "Copied: %s" link)) + (message "Point is not an org link!")))) + +(defun my-org-link-at-point () + (interactive) + (when (org-in-regexp org-link-any-re) + (org-unbracket-string "<" ">" + (or + ;; [[target][desc]] + (match-string-no-properties 2) + ;; plain link or <...> + (match-string-no-properties 0))))) + +(defun my-org-store-link-and-return () + "run org-goto to select a heading, stores its link and insert it." + (interactive) + (save-restriction + (widen) + (save-excursion + (call-interactively 'org-goto) + (call-interactively 'org-store-link))) + (call-interactively 'org-insert-last-stored-link)) + +;; overload org-insert-all-links (do we need autoload as in the original file?) +(defun my-org-insert-all-links (arg &optional pre post) + "Insert all links in `org-stored-links'. +When a universal prefix, do not delete the links from `org-stored-links'. +When `ARG' is a number, insert the last N link(s). +`PRE' and `POST' are optional arguments to define a string to +prepend or to append." + (interactive "P") + (let ((org-link-keep-stored-after-insertion (equal arg '(4))) + (links (copy-sequence org-stored-links)) + (pr (or pre "- ")) + (po (or post "\n")) + (cnt 1) l) + (if (null org-stored-links) + (message "No link to insert") + (while (and (or (listp arg) (>= arg cnt)) + (setq l (if (listp arg) + (pop links) + (pop org-stored-links)))) + (setq cnt (1+ cnt)) + (insert pr) + (org-insert-link nil (car l) (or (cadr l) "")) + (insert po))))) + +;; overload org-open-at-point-global to fix bug property link not +;; opened in external browser (2d0e61c8-da74-417e-8ccd-c4099ccd88d8) +(defun my-org-open-at-point-global (&optional arg) + "Follow a link or a time-stamp like Org mode does. +Also follow links and emails as seen by `thing-at-point'. +This command can be called in any mode to follow an external +link or a time-stamp that has Org mode syntax. Its behavior +is undefined when called on internal links like fuzzy links. +Raise a user error when there is nothing to follow." + (interactive "P") + (let ((tap-url (thing-at-point 'url)) + (tap-email (thing-at-point 'email))) + (cond ((org-in-regexp org-link-any-re) + (org-link-open-from-string (match-string-no-properties 0) arg)) + ((or (org-in-regexp org-ts-regexp-both nil t) + (org-in-regexp org-tsr-regexp-both nil t)) + (org-follow-timestamp-link)) + (tap-url (org-link-open-from-string tap-url)) + (tap-email (org-link-open-from-string + (concat "mailto:" tap-email))) + (t (user-error "No link found"))))) + +;; overload org-refile-get-targets +(defun my-org-refile-get-targets (&optional default-buffer) + "Produce a table with refile targets." + (let ((case-fold-search nil) + ;; otherwise org confuses "TODO" as a kw and "Todo" as a word + (entries (or org-refile-targets '((nil . (:level . 1))))) + targets tgs files desc descre) + (message "Getting targets...") + (with-current-buffer (or default-buffer (current-buffer)) + (dolist (entry entries) + (setq files (car entry) desc (cdr entry)) + (cond + ((null files) (setq files (list (current-buffer)))) + ((eq files 'org-agenda-files) + (setq files (org-agenda-files 'unrestricted))) + ((and (symbolp files) (fboundp files)) + (setq files (funcall files))) + ((and (symbolp files) (boundp files)) + (setq files (symbol-value files)))) + (when (stringp files) (setq files (list files))) + (cond + ((eq (car desc) :tag) + (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) + ((eq (car desc) :todo) + (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) + ((eq (car desc) :regexp) + (setq descre (cdr desc))) + ((eq (car desc) :level) + (setq descre (concat "^\\*\\{" (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + ((eq (car desc) :maxlevel) + (setq descre (concat "^\\*\\{1," (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + (t (error "Bad refiling target description %s" desc))) + (dolist (f files) + (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) + (or + (setq tgs (org-refile-cache-get + (buffer-file-name + (when (bufferp f) (buffer-base-buffer f))) + descre)) + (progn + (when (bufferp f) + (setq f (buffer-file-name (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (when (eq org-refile-use-outline-path 'file) + (push (list (and f (file-name-nondirectory f)) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'buffer-name) + (push (list (buffer-name (buffer-base-buffer)) f nil nil) tgs)) + (when (eq org-refile-use-outline-path 'full-file-path) + (push (list (and (buffer-file-name (buffer-base-buffer)) + (file-truename (buffer-file-name (buffer-base-buffer)))) + f nil nil) tgs)) + (org-with-wide-buffer + (goto-char (point-min)) + (setq org-outline-path-cache nil) + (while (re-search-forward descre nil t) + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((begin (point)) + (heading (match-string-no-properties 4))) + (unless (or (and + org-refile-target-verify-function + (not + (funcall org-refile-target-verify-function))) + (not heading)) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (target + (if (not org-refile-use-outline-path) heading + (mapconcat + #'identity + (append + (pcase org-refile-use-outline-path + (`file (list + (and (buffer-file-name (buffer-base-buffer)) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))))) + (`full-file-path + (list (buffer-file-name + (buffer-base-buffer)))) + (`buffer-name + (list (buffer-name + (buffer-base-buffer)))) + (_ nil)) + (mapcar (lambda (s) (replace-regexp-in-string + "/" "\\/" s nil t)) + (org-get-outline-path t t))) + "/")))) + (push (list target f re (org-refile-marker (point))) + tgs))) + (when (= (point) begin) + ;; Verification function has not moved point. + (end-of-line))))))) + (when org-refile-use-cache + (org-refile-cache-put tgs (buffer-file-name) descre)) + (setq targets (append tgs targets)))))) + (message "Getting targets...done") + (delete-dups (nreverse targets)))) + +;; shadow org-insert-last-stored-link (do not insert \n at the end) +(defun my-org-insert-last-stored-link (arg) + "Insert the last link stored in `org-stored-links'." + (interactive "p") + (org-insert-all-links arg "" "")) + +(defun my-org-info-open-new-window (path) + "Open info in a new buffer" + (my-select-new-window-matching-mode 'Info-mode) + (org-info-follow-link path)) + +(defun my-org-rt-open-new-window (path) + "Open rt in a new buffer" + (my-select-new-window-matching-mode 'rt-liber-browser-mode) + (rt-org-open path)) + +;; fix org src overlay face +(defun my-org-src--make-source-overlay (beg end edit-buffer) + "Create overlay between BEG and END positions and return it. +EDIT-BUFFER is the buffer currently editing area between BEG and +END." + (let ((overlay (make-overlay beg end))) + (overlay-put overlay 'face 'region) + (overlay-put overlay 'edit-buffer edit-buffer) + (overlay-put overlay 'help-echo + "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put overlay 'face 'region) + (overlay-put overlay 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (let ((read-only + (list + (lambda (&rest _) + (user-error + "Cannot modify an area being edited in a dedicated buffer"))))) + (overlay-put overlay 'modification-hooks read-only) + (overlay-put overlay 'insert-in-front-hooks read-only) + (overlay-put overlay 'insert-behind-hooks read-only)) + overlay)) + +(defun my-org-copy-property-value (name) + (interactive + (list (completing-read "Copy property: " (org-entry-properties)))) + (let ((value (org-entry-get (point) name))) + (kill-new value) + (message "Copied %s" value))) + +(defvar my-org-common-properties nil + "Property list for completion when setting the property of an org node, to + avoid scanning the whole notes.") + +(defun my-org-set-common-property () + (interactive) + (let* ((property + (completing-read "Which property to set: " + my-org-common-properties)) + (value + (org-read-property-value property))) + (org-set-property property value))) + +(defun my-org-copy-src-block-at-point () + (interactive) + (when (org-in-src-block-p) + (kill-new (nth 1 (org-babel-get-src-block-info t))) + (message "org src block copied!"))) +(defun my-org-in-or-at-block-p () + (or (org-at-block-p) + (org-in-block-p '("example" "source" "export" + "center" "quote" "verse")))) +(defun my-org-copy-block-at-point () + (interactive) + (save-excursion + (unless (org-at-block-p) + (org-previous-block 1) + (let ((element (org-element-at-point))) + (kill-new (or + (org-element-property :value element) + (buffer-substring + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + (message "org block copied!"))))) + +;; clock save timer doesn't seem to be working +(defun my-org-clock-maybe-save () + (when (equal major-mode 'org-mode) + (org-clock-save))) + +(defun my-org-refile-cache-rebuild () + (org-refile-cache-clear) + (org-refile-get-targets)) + +(defun my-org-store-agenda-view-A () + (interactive) + (org-store-agenda-views) + (my-org-agenda-ensure-A)) + +(defun my-org-agenda-priority-0 () + (interactive) + (org-agenda-priority ?\ )) +(defun my-org-agenda-priority-A () + (interactive) + (org-agenda-priority ?A)) +(defun my-org-agenda-priority-B () + (interactive) + (org-agenda-priority ?B)) +(defun my-org-agenda-priority-C () + (interactive) + (org-agenda-priority ?C)) + +(defun my-org-next-block-or-results (arg &optional backward) + "Jump to the next block or results. + +With a prefix argument ARG, jump forward ARG many blocks. + +When BACKWARD is non-nil, jump to the previous block. + +When BLOCK-REGEXP is non-nil, use this regexp to find blocks. +Match data is set according to this regexp when the function +returns. + +Return point at beginning of the opening line of found block. +Throw an error if no block is found." + (interactive "p") + (let ((re "^[ \t]*#\\+\\(BEGIN\\|RESULTS:\\)") + (case-fold-search t) + (search-fn (if backward #'re-search-backward #'re-search-forward)) + (count (or arg 1)) + (origin (point)) + last-element) + (if backward (beginning-of-line) (end-of-line)) + (while (and (> count 0) (funcall search-fn re nil t)) + (let ((element (save-excursion + (goto-char (match-beginning 0)) + (save-match-data (org-element-at-point))))) + (when (and (memq (org-element-type element) + '(center-block comment-block dynamic-block + example-block export-block quote-block + special-block src-block verse-block fixed-width)) + (<= (match-beginning 0) + (org-element-property :post-affiliated element))) + (setq last-element element) + (cl-decf count)))) + (if (= count 0) + (prog1 (goto-char (org-element-property :post-affiliated last-element)) + (save-match-data (org-show-context))) + (goto-char origin) + (user-error "No %s code blocks" (if backward "previous" "further"))))) + +(defun my-org-previous-block-or-results (arg) + "Jump to the previous block or results. +With a prefix argument ARG, jump backward ARG many source blocks. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (my-org-next-block-or-results arg t)) + +;; override org-next-link to include search in any places, including property +;; drawers. +;; TODO: not working yet +;; https://lists.gnu.org/archive/html/emacs-orgmode/2020-01/msg00186.html +(defun my-org-next-link () + (interactive) + (when (org-in-regexp org-any-link-re) + (re-search-forward org-any-link-re nil t)) + (re-search-forward org-any-link-re nil t) + (re-search-backward org-any-link-re nil t) + (when-let ((link (org-element-lineage (org-element-context) '(link) t))) + (goto-char (org-element-property :begin link))) + (when (org-invisible-p) (org-show-context))) + +(defun my-org-previous-link () + (interactive) + (re-search-backward org-any-link-re nil t) + (when-let ((link (org-element-lineage (org-element-context) '(link) t))) + (goto-char (org-element-property :begin link))) + (when (org-invisible-p) (org-show-context))) + +(defun my-org-attach-edit-attached-image () + (interactive) + (start-process + "pinta" nil "/usr/bin/pinta" + (concat (org-attach-dir) "/" + (org-element-property :path (org-element-context))))) + +(defun my-org-capture-place-template-dont-delete-windows (oldfun args) + (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 + (format "\\.\\(%s\\)$" + (string-join + my-org-attach-copy-attached-doc-exts "\\|"))) + +(defun my-org-attach-copy-attached-docs () + (interactive) + (let* ((name + (completing-read "Copy attached docs to: " + my-org-attach-copy-attached-targets)) + (path (alist-get name my-org-attach-copy-attached-targets + nil nil #'equal))) + (let ((basedir (org-attach-dir))) + (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 path) + (copy-file (file-name-concat basedir attached) + (file-name-concat + path + (replace-regexp-in-string ":" "_" attached))) + (message "Done!"))))) + ) + +(defun my-org-attach-all-url-plaintext (arg) + (interactive "P") + (dolist (url (my-org-http-s-links-in-entry)) + (my-org-attach-url-plaintext url))) + +(defun my-org-attach-url-plaintext (url) + (interactive (list (completing-read "Url to fetch: " (my-org-http-s-links-in-entry)))) + (my-org-attach-url-plaintext-internal url current-prefix-arg t)) + +(defun my-org-attach-url-plaintext-all-media (url) + (interactive (list (completing-read "Url to fetch: " + (my-org-http-s-links-in-entry)))) + (my-org-attach-url-plaintext-internal url current-prefix-arg t t)) + +(defun my-org-attach-url (url) + (interactive (list (completing-read "Url to fetch: " + (my-org-http-s-links-in-entry)))) + (let* ((url (my-rewrite-url url)) + (filename (expand-file-name (my-make-filename-from-url url) + (org-attach-dir t)))) + (my-wget-async url filename current-prefix-arg))) + +(defun my-org-attach-url-plaintext-internal (url &optional no-tor move-if-large save-all-media) + (let* ((lynx-buffer (format "*lynx %s*" url)) + (url (my-rewrite-url url)) + (filename (expand-file-name (my-make-filename-from-url url) + (org-attach-dir t))) + (coding-system-for-write 'utf-8)) + (ignore-errors (kill-buffer lynx-buffer)) + (my-touch-new-file filename) + (org-attach-sync) + (set-process-sentinel + (my-start-process-with-torsocks + current-prefix-arg + "org-lynx" lynx-buffer "lynx" "-dump" "--display_charset" "utf-8" url) + (lambda (process event) + (with-current-buffer (process-buffer process) + (goto-char (point-min)) + (write-file filename) + (message "Lynx dumped to: %s" filename) + (when save-all-media + (when-let ((urls (http-s-media-links-in-buffer))) + (message "Downloading %d media files..." (length urls)) + (wget-async-urls-with-prefix + urls (concat filename "-") no-tor move-if-large)))))))) + +;; node creation; start of grok +;; FIXME: decouple clients from org +(defun my-org-create-node (info &optional attach) + (cond ((alist-get "Authors" info nil nil 'string=) + (my-org-create-book-node info attach)) + ((alist-get "Director" info nil nil 'string=) + (my-org-create-video-node info attach)) + ((and (alist-get "Developers" info nil nil 'string=) + (string-match "\\<game\\>" + (alist-get "Description" info nil nil 'string=))) + (my-org-create-video-game-node info attach)) + ((alist-get "Developers" info nil nil 'string=) + (my-org-create-software-node info attach)) + ((alist-get "Designers" info nil nil 'string=) + (my-org-create-game-node info attach)) + ((alist-get "Founded" info nil nil 'string=) + (my-org-create-organisation-node info attach)) + ((alist-get "Latitude" info nil nil 'string=) + (my-org-create-location-node info attach)) + ((alist-get "Born" info nil nil 'string=) + (my-org-create-people-node info attach)) + (t (my-org-create-entity-node info attach)))) + +(defun my-org-attach-and-add-properties-to-node (info attach) + (when (and attach (alist-get "Cover" info nil nil 'string=)) + (ignore-error 'file-already-exists + (org-attach-url (alist-get "Cover" info nil nil 'string=))) + (setq info (assoc-delete-all "Cover" info 'string=))) + (dolist (pair info) + (when (and (cdr pair) (string> (cdr pair) "")) + (org-entry-put (point) + (decode-coding-string (car pair) 'utf-8) + (decode-coding-string (cdr pair) 'utf-8)))) + (org-entry-put (point) "CREATED" + (format-time-string "[%Y-%m-%d %a %H:%M]" (current-time))) + (org-attach-sync) + (when (buffer-narrowed-p) + (goto-char (point-min)))) + +(defun my-org-create-book-node (book-info attach) + (org-capture nil "book") + (insert (format + "%s - %s - %s" + (or (alist-get "Authors" book-info "" nil 'string=) "") + (alist-get "Title" book-info "" nil 'string=) + (my-extract-year + (alist-get "Published" book-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node book-info attach)) +(defun my-org-create-video-node (video-info attach) + (org-capture nil "video") + (insert (format + "%s - %s - %s" + (alist-get "Director" video-info "" nil 'string=) + (alist-get "Title" video-info "" nil 'string=) + (my-extract-year + (alist-get "Released" video-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node video-info attach)) +(defun my-org-create-location-node (book-info attach) + (org-capture nil "location") + (insert (format + "%s" + (alist-get "Title" book-info "" nil 'string=))) + (my-org-attach-and-add-properties-to-node book-info attach)) +(defun my-org-create-game-node (game-info attach) + (org-capture nil "game") + (insert (format + "%s - %s - %s" + (alist-get "Designers" game-info "" nil 'string=) + (alist-get "Title" game-info "" nil 'string=) + (my-extract-year + (alist-get "Published" game-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node game-info attach)) +(defun my-org-create-video-game-node (game-info attach) + (org-capture nil "videogame") + (insert (format + "%s - %s - %s" + (alist-get "Developers" game-info "" nil 'string=) + (alist-get "Title" game-info "" nil 'string=) + (my-extract-year + (alist-get "Released" game-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node game-info attach)) +(defun my-org-create-software-node (software-info attach) + (org-capture nil "software") + (insert (format + "%s - %s" + (alist-get "Title" software-info "" nil 'string=) + (my-extract-year + (alist-get "Released" software-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node software-info attach)) +(defun my-org-create-organisation-node (organisation-info attach) + (org-capture nil "organisation") + (insert (format + "%s - %s" + (alist-get "Title" organisation-info "" nil 'string=) + (my-extract-year + (alist-get "Founded" organisation-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node organisation-info attach)) +(defun my-org-create-people-node (people-info attach) + (org-capture nil "people") + (insert (format + "%s - %s-%s" + (alist-get "Title" people-info "" nil 'string=) + (my-extract-year (alist-get "Born" people-info "" nil 'string=)) + (my-extract-year (alist-get "Died" people-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node people-info attach)) +(defun my-org-create-pacman-software-node (package) + (interactive "sPacman package name: ") + (my-org-create-software-node (my-grok-pacman package) nil)) +(defun my-org-create-entity-node (entity-info attach) + (org-capture nil "entity") + (insert (format + "%s" + (alist-get "Title" entity-info "" nil 'string=))) + (my-org-attach-and-add-properties-to-node entity-info attach)) +(defun my-org-create-audio-node (audio-info attach) + (org-capture nil "ya") + (insert (format + "%s - %s - %s" + (or (alist-get "Authors" audio-info "" nil 'string=) "") + (alist-get "Title" audio-info "" nil 'string=) + (my-extract-year + (alist-get "Published" audio-info "" nil 'string=)))) + (my-org-attach-and-add-properties-to-node audio-info attach)) + +;; TODO: these requires are unnecessary for more essential functionalities of +;; org customisation. Find a way to delay them +(require 'my-wikipedia) +(require 'my-github) +(require 'my-gitlab) +(require 'my-pacman) +(require 'my-openlibrary) +(defun my-grok-dispatcher (url) + (when-let ((host (url-host (url-generic-parse-url url)))) + (cond ((string-match "wikipedia\\.org" host) 'my-grok-wikipedia) + ((string-match "github\\.com" host) 'my-grok-github) + ((string-match "\\(gitlab\\.\\|salsa.debian.org\\)" host) + 'my-grok-gitlab) + ((string-match "openlibrary.org" host) 'my-grok-openlibrary) + (t nil)))) +(defun my-grok-update-properties () + (interactive) + (when-let* ((url (org-entry-get (point) "Source")) + (source-dispatcher (my-grok-dispatcher url))) + (my-org-attach-and-add-properties-to-node + (funcall source-dispatcher url) t)) + (when-let ((isbn (org-entry-get (point) "ISBN"))) + (my-org-attach-and-add-properties-to-node (my-grok-openlibrary-isbn isbn) t)) + (when-let ((url (org-entry-get (point) "OpenLibrary-link"))) + (my-org-attach-and-add-properties-to-node (my-grok-openlibrary url) t)) + (when-let ((package (org-entry-get (point) "Pacman-package-name"))) + (my-org-attach-and-add-properties-to-node (my-grok-pacman package) nil)) + (when-let ((url (org-entry-get (point) "Wikipedia-link"))) + (my-org-attach-and-add-properties-to-node (my-grok-wikipedia url) t))) +(defun my-org-protocol-grok (data) + (when-let ((url (plist-get data :url))) + (my-org-grok url)) + nil) + +(defun my-org-grok (url) + (when-let* ((grok-fun (my-grok-dispatcher url)) + (info (funcall grok-fun url))) + (my-org-create-node info t))) + +(defun my-eww-org-protocol-grok () + "grok from eww" + (interactive) + (org-protocol-grok + (list :url (plist-get eww-data :url)))) + +;; org capture rss +(defun my-org-rss-xml-create-audio-node (url) + (interactive (list (read-string "Feed URL: " + (thing-at-point-url-at-point)))) + (my-org-rss-xml-create-node url 'my-org-create-audio-node)) +(defun my-org-rss-xml-create-book-node (url) + (interactive (list (read-string "Feed URL: " + (thing-at-point-url-at-point)))) + (my-org-rss-xml-create-node url 'my-org-create-book-node)) +(defun my-org-rss-xml-create-node (url create-node-fun) + (let* ((xml + (with-current-buffer (url-retrieve-synchronously url) + (my-skip-http-header) + (car (xml-parse-region (point) (point-max))))) + (channel (my-xml-get-first-child xml 'channel)) + ) + (funcall create-node-fun + (list + (cons "Feed-url" url) + (cons "Title" (decode-coding-string + (my-xml-get-first-child-text channel 'title) 'utf-8)) + (cons "Description" + (decode-coding-string + (my-xml-get-first-child-text channel 'description) 'utf-8)) + (cons "Website" (my-xml-get-first-child-text channel 'link)) + (cons "Cover" + (or (my-xml-get-first-child-text + (my-xml-get-first-child channel 'image) 'url) + (dom-attr + (my-xml-get-first-child channel 'itunes:image) 'href))) + (cons "Authors" (my-xml-get-first-child-text + channel 'itunes:author))) + t))) + +(require 'my-algo) +(defun my-radix-org-from-tree (tree) + (let ((radix-tree-type 'vector)) + (radix-tree-iter-subtrees + tree + (my-radix-org-iter-n 1 [])))) + +(defun my-radix-org-iter-n (depth prefix) + (lambda (p s) + (let ((nprefix (seq-concatenate radix-tree-type prefix p))) + (insert (make-string depth ?*) " ") + (pcase s + ((radix-tree-leaf v) (insert "[[" (string-join nprefix "/") "][" (string-join p "/") "]]" "\n")) + (_ + (insert (string-join p "/") "\n") + (radix-tree-iter-subtrees s (my-radix-org-iter-n (1+ depth) nprefix))))))) + +(defun my-radix-org () + (interactive) + (let* ((file-name (buffer-file-name)) + (buffer-name (file-name-with-extension + (file-name-base file-name) + "org")) + (save-file-name (file-name-with-extension file-name "org")) + (tree (let ((max-lisp-eval-depth 32000)) + (save-excursion (my-radix-tree-from-list))))) + (with-current-buffer (get-buffer-create buffer-name) + (org-mode) + (erase-buffer) + (my-radix-org-from-tree tree) + (goto-char (point-min))) + (switch-to-buffer buffer-name))) + +;;; format org mode elements +(defun my-org-format-link (url text) + (format "[[%s][%s]]" url text)) + +(defun my-org-format-heading (text level) + (format "%s %s" + (make-string level ?*) text)) + +(defun my-org-update-updated () + (interactive) + (when (derived-mode-p 'org-mode) + (org-entry-put + (point) "UPDATED" + (format-time-string "[%Y-%m-%d %a %H:%M]" (current-time))))) + +;;; override org-recoll-format-results +(defun my-org-recoll-format-results () + (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 "\\/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)) + +(defun my-org-recoll-mdn (query) + (interactive "sSearch mdn: ") + (org-recoll-search (format "%s dir:mdn" query))) + +(defun my-org-recoll-python (query) + (interactive "sSearch python: ") + (org-recoll-search (format "%s dir:python-3.9.7-docs-html" query))) + +(defun my-org-recoll-php (query) + (interactive "sSearch php: ") + (org-recoll-search (format "%s dir:php-chunked-xhtml" query))) + +(defun my-org-recoll-yesod (query) + (interactive "sSearch yesod: ") + (org-recoll-search (format "%s dir:yesod-cookbook OR dir:yesodweb.com" query))) + +(defun my-org-entry-at-point-to-tsv (id) + (string-join + (cons (number-to-string id) + (mapcar + (lambda (key) (org-entry-get (point) key)) + (list "ITEM" "Referral" "Wikipedia-link" "IMDB-link"))) + "\t")) + +(defvar org-entries-tsv-buffer "*org-entries-tsv*") +(defun my-org-entries-at-point-to-tsv (beg end) + (interactive "r") + (with-current-buffer (get-buffer-create org-entries-tsv-buffer) + (erase-buffer)) + (let ((row) (id 0)) + (save-excursion + (goto-char beg) + (while (< (point) end) + (when (equal (org-entry-get (point) "TODO") "TODO") + (setq row (my-org-entry-at-point-to-tsv id)) + (with-current-buffer org-entries-tsv-buffer + (insert row "\n")) + (setq id (1+ id))) + (org-next-visible-heading 1)))) + (switch-to-buffer-other-window org-entries-tsv-buffer)) + +(defun my-org-entries-attach-plaintext-all-media (beg end) + (interactive "r") + (save-excursion + (goto-char beg) + (while (< (point) end) + (my-org-attach-url-plaintext-all-media (car (my-org-http-s-links-in-entry))) + (org-next-visible-heading 1)))) + +(defvar my-org-doc-dir nil "Directory to docs written in org.") +(defun my-org-open-org-doc (filename) + (interactive + (list + (completing-read + "Open org doc: " + (mapcar (lambda (name) (substring name (length my-org-doc-dir))) + (directory-files-recursively my-org-doc-dir "\\.org$"))))) + (find-file (concat my-org-doc-dir filename))) + +(defun my-org-open-org-file (filename) + (interactive + (list + (completing-read + "Open org file: " + (directory-files org-directory nil "\\.org$")))) + (find-file (file-name-concat org-directory filename))) + +(defun my-org-agenda-after-show () (beginning-of-line 1)) + +(defun my-org-agenda-ensure-A () + (org-agenda nil "A") + (unless (get-text-property (point) 'org-series-redo-cmd) + (kill-buffer) + (org-agenda nil "A"))) + +(defun my-org-agenda-redo-all () + (interactive) + (message "time now is %s" + (format-time-string "%Y-%m-%d %a %H:%M:%S" (current-time))) + (my-org-agenda-ensure-A) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'org-agenda-mode) + (print buffer) + (org-agenda-redo t))))) + +(defun my-org-copy-dwim () + (interactive) + (cond ((org-in-src-block-p) + (my-org-copy-src-block-at-point)) + ((my-org-in-or-at-block-p) (my-org-copy-block-at-point)) + (t (org-refile-copy)))) + +;; to override `org--mouse-open-at-point' - we don't want +;; `org-open-at-point' to toggle a checkbox when point is at the +;; beginning of a link +(defun my-org--mouse-open-at-point (orig-fun &rest args) + (let ((context (org-context))) + (cond + ((assq :headline-stars context) (org-cycle)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + ((org-footnote-at-reference-p) nil) + (t (apply orig-fun args))))) + +(provide 'my-org) +;;; my-org.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-osm.el b/emacs/.emacs.d/lisp/my/my-osm.el new file mode 100644 index 0000000..6c3b607 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-osm.el @@ -0,0 +1,56 @@ +;;; my-osm.el -- Extensions for osm.el -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for osm.el. + +;;; Code: + + + +(defun my-org-osm-goto () + (interactive) + (when-let ((lat (string-to-number (org-entry-get (point) "Latitude"))) + (lon (string-to-number (org-entry-get (point) "Longitude")))) + (osm-goto lat lon 17))) + +(defun my-osm-org-add-properties () + "find the latest osm buffer, and add the lon and lat to the current org node." + (interactive) + (let ((lat) (lon)) + (with-current-buffer + (window-buffer + (cl-find-if (lambda (window) + (with-current-buffer (window-buffer window) + (equal major-mode 'osm-mode))) + (window-list))) + (setq lat (osm--lat) lon (osm--lon))) + (org-entry-put (point) "Latitude" (number-to-string lat)) + (org-entry-put (point) "Longitude" (number-to-string lon)))) + +(defun my-osm-show-center () + (interactive) + (osm--put-transient-pin 'osm-center osm--x osm--y "Center")) + +(provide 'my-osm) +;;; my-osm.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-package.el b/emacs/.emacs.d/lisp/my/my-package.el new file mode 100644 index 0000000..1f35a5e --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-package.el @@ -0,0 +1,263 @@ +;;; my-package.el -- Package related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Maintainer: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Package related extensions for emacs core. + +;;; Code: + + +;;; Needed by `my-keybind' for barebone profiles like "emms". +(require 'cl-lib) +;;; Much of the following is adapted from prot-dotfiles +(defcustom my-omit-packages nil + "List of package names to not load. +This instructs the relevant macros to not `require' the given +package." + :group 'my + :type '(repeat symbol)) + +(defcustom my-allowed-packages nil + "List of package names to load. +This instructs the relevant macros to not `require' packages not +in this list. Nil means all packages can be required." + :group 'my + :type '(repeat symbol)) + +(defun my-package-install (package &optional method) + "Install PACKAGE with optional METHOD. + +If METHOD is nil or the `builtin' symbol, PACKAGE is not +installed as it is considered part of Emacs. + +If METHOD is any non-nil value, install PACKAGE using +`package-install'." + (unless (or (eq method 'builtin) (null method)) + (unless (package-installed-p package) + (unless package-archive-contents + (package-refresh-contents)) + (package-install package)))) + +(defmacro my-package (package &rest body) + "Require PACKAGE with BODY configurations. + +PACKAGE is an unquoted symbol that is passed to `require'. It +thus conforms with `featurep'. + +BODY consists of ordinary Lisp expressions. There are, +nevertheless, two unquoted plists that are treated specially: + +1. (:install METHOD) +2. (:delay NUMBER) + +These plists can be anywhere in BODY and are not part of its +final expansion. + +The :install property is the argument passed to +`my-package-install' and has the meaning of METHOD +described therein. + +The :delay property makes the evaluation of PACKAGE with the +expanded BODY happen with `run-with-timer'. + +Also see `my-configure'." + (declare (indent 1)) + (when (or (not my-allowed-packages) + (memq package my-allowed-packages)) + (unless (memq package my-omit-packages) + (let (install delay) + (dolist (element body) + (when (let ((len (proper-list-p element))) + (and len (zerop (% len 2)))) + (pcase (car element) + (:install (setq install (cdr element) + body (delq element body))) + (:delay (setq delay (cadr element) + body (delq element body)))))) + (let ((common `(,(when install + `(my-package-install ',package ,@install)) + (require ',package) + ,@body + ))) + (cond + ((featurep package) + `(progn ,@body)) + (delay + `(run-with-timer ,delay nil (lambda () ,@(delq nil common)))) + (t + `(progn ,@(delq nil common))))))))) + +(defmacro my-keybind (keymap &rest definitions) + "Expand key binding DEFINITIONS for the given KEYMAP. +DEFINITIONS is a sequence of string and command pairs." + (declare (indent 1)) + (unless (zerop (% (length definitions) 2)) + (error "Uneven number of key+command pairs")) + (let ((keys (seq-filter #'stringp definitions)) + ;; We do accept nil as a definition: it unsets the given key. + (commands (seq-remove #'stringp definitions))) + `(when-let (((keymapp ,keymap)) + (map ,keymap)) + ,@(mapcar + (lambda (pair) + (unless (and (null (car pair)) + (null (cdr pair))) + `(define-key map (kbd ,(car pair)) ,(cdr pair)))) + (cl-mapcar #'cons keys commands))))) + +(defmacro my-configure (&rest body) + "Evaluate BODY as a `progn'. +BODY consists of ordinary Lisp expressions. The sole exception +is an unquoted plist of the form (:delay NUMBER) which evaluates +BODY with NUMBER seconds of `run-with-timer'. + +Note that `my-configure' does not try to autoload +anything. Use it only for forms that evaluate regardless. + +Also see `my-package'." + (declare (indent 0)) + (let (delay) + (dolist (element body) + (when (let ((len (proper-list-p element))) + (and len (zerop (% len 2)))) + (pcase (car element) + (:delay (setq delay (cadr element) + body (delq element body)))))) + (if delay + `(run-with-timer ,delay nil (lambda () ,@body)) + `(progn ,@body)))) + +(defvar my-local-config-file + (locate-user-emacs-file "local-config") + "Local emacs-lisp-data config file for machine-specific and personal + information. The content of the file should be an alist of (var-name + . var-value)") + +(defun my-read-local-config () + "Read local-config. + +Read from `my-local-config-file' into `local-config'." + (interactive) + (setq my-local-config + (with-temp-buffer + (insert-file-contents my-local-config-file) + (read (current-buffer))))) + +(defmacro my-setq-from-local (&rest var-names) + "Set variables with values from `local-config'. + +Does not set variables that do not appear in `local-config'. +Note that symbols or list values in `local-config' need to be +quoted." + (cons 'setq + (mapcan + (lambda (var-name) + (when-let ((pair (assoc `,var-name my-local-config))) + `(,(car pair) ',(cdr pair)))) + var-names))) + +(defmacro my-setq-from-local-1 (&rest var-names) + "Update the local config before calling `my-setq-from-local'" + `(progn (my-read-local-config) + (my-setq-from-local ,@var-names))) + +(defmacro my-get-from-local (var-name) + "Get the value of a variable from `local-config'" + `(alist-get ',var-name my-local-config)) + +(defmacro my-get-from-local-1 (var-name) + "Update the local config before calling `my-get-from-local'" + `(progn (my-read-local-config) + (my-get-from-local ,var-name))) + +(defmacro my-override (func-name) + "Override a function named foo with a function named my-foo" + `(advice-add ',func-name :override #',(intern (format "my-%s" func-name)))) + +(defmacro my-server-idle-timer (var-name secs repeat function) + "Create an idle timer if we are in an emacsclient. + +The timer has name VAR-NAME. If there is an existing time with the +same name, cancel that one first." + + `(when (my-server-p) + (when (and (boundp ',var-name) (timerp ,var-name)) + (cancel-timer ,var-name)) + (setq ,var-name (run-with-idle-timer ,secs ,repeat ,function)))) + +(defmacro my-server-timer (var-name secs repeat function) + "Create a timer if we are in an emacsclient. + +The timer has name VAR-NAME. If there is an existing time with the +same name, cancel that one first." + + `(when (my-server-p) + (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 + "\\b\\(?:elpa.gnu.org/packages/\\|elpa.gnu.org/devel/\\|elpa.nongnu.org/nongnu/\\)\\(.*\\).html" + url) + (describe-package (intern (match-string 1 url))))) + +(defun my-generate-local-config () + "Generate a local config and insert it to a buffer named *local-config*" + (with-current-buffer (get-buffer-create "*local-config*") + (erase-buffer) + (insert + (pp + (seq-map + (lambda (var) + (cons var (when (boundp var) (symbol-value var)))) + (seq-uniq + (my-collect-my-setqd-vars + (with-temp-buffer + (insert "(progn ") + (dolist (el (directory-files "~/.emacs.d/init" t + directory-files-no-dot-files-regexp)) + (insert-file-contents el) + (goto-char (point-max))) + (insert ")") + (goto-char (point-min)) + (read (current-buffer)) + ))))))) + (pop-to-buffer "*local-config*") + ) + +(defun my-collect-my-setqd-vars (xs) + "Collect vars that have been `my-setq-from-local''d" + (cond + ((not (listp xs)) nil) + ((not xs) nil) + ((eq (car xs) 'my-setq-from-local) + (cdr xs)) + (t (append (my-collect-my-setqd-vars (car xs)) + (my-collect-my-setqd-vars (cdr xs)))))) + +(provide 'my-package) +;;; my-package.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-pacman.el b/emacs/.emacs.d/lisp/my/my-pacman.el new file mode 100644 index 0000000..01cbfdd --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-pacman.el @@ -0,0 +1,46 @@ +;;; my-pacman.el -- pacman client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; pacman client. + +;;; Code: + +;;; a pacman client +(defun my-grok-pacman (package) + (ignore-errors (kill-buffer "*pacman*")) + (if (= 0 + (call-process-shell-command + (concat "pacman -Si " package) nil "*pacman*")) + (my-process-pacman-info + (my-parse-colon-separated-output "*pacman*")) + (error (format "Failed to find package %s!" package)))) + +(defun my-process-pacman-info (info) + (list (cons "Description" (alist-get "Description" info nil nil 'string=)) + (cons "Website" (alist-get "URL" info nil nil 'string=)) + (cons "License" (alist-get "Licenses" info nil nil 'string=)) + (cons "Pacman-package-name" (alist-get "Name" info nil nil 'string=)))) + +(provide 'my-pacman) +;;; my-pacman.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-pdf-tools.el b/emacs/.emacs.d/lisp/my/my-pdf-tools.el new file mode 100644 index 0000000..8fe884c --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-pdf-tools.el @@ -0,0 +1,200 @@ +;;; my-pdf-tools.el -- Extensions for pdf-tools -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for pdf-tools. + +;;; Code: + +(require 'pdf-tools) +(defvar my-pdf-view-current-node nil) +(defvar my-pdf-view-navigation-functions + '(my-pdf-view-forward-node + my-pdf-view-backward-node + my-pdf-view-forward-node-same-depth + my-pdf-view-backward-node-same-depth + my-pdf-view-backward-node-lower-depth)) + +(defun my-pdf-outline-update-with-path (outline) + (let ((path) (depth 0)) + (dolist (node outline) + (let* ((node-depth (alist-get 'depth node)) + (node-title (alist-get 'title node)) + (depth-diff (- node-depth depth 1))) + (cond ((< depth-diff 0) (dotimes (unused (- depth-diff)) + (pop path))) + ((> depth-diff 0) (dotimes (unused depth-diff) + (push "" path)))) + (push node-title path) + (setq depth node-depth)) + (setf (alist-get 'title node) (string-join (reverse path) "/"))) + outline)) + +(defun my-pdf-jump-and-set-current-node (node) + (pdf-links-action-perform node) + (setq my-pdf-view-current-node node)) + +(defun my-pdf-outline-jump () + (interactive) + (let ((outline (my-pdf-outline-update-with-path + (pdf-info-outline (current-buffer))))) + (if (not outline) (message "PDF has no outline") + (let ((title (completing-read + "Jump to: " + (mapcar (lambda (node) (alist-get 'title node)) + outline)))) + (pdf-links-action-perform + (cl-find-if (lambda (node) (equal (alist-get 'title node) title)) + outline)))))) + +(defun my-pdf-view-next-node-by-page (outline) + (cl-find-if (lambda + (node) + (> (alist-get 'page node) (pdf-view-current-page))) outline)) + +(defun my-pdf-view-next-node-by-node (current-node outline &optional depth-req) + (let ((next-node + (catch 'ret + (while outline + (when (equal (car outline) current-node) + (throw 'ret (cadr outline))) + (setq outline (cdr outline)))))) + (cond ((not depth-req) next-node) + ((eq depth-req 'same-depth) + (cl-find-if (lambda (node) (= (alist-get 'depth node) + (alist-get 'depth current-node))) + (cdr outline))) + (t (error "Unknown depth-req"))))) + +(defun my-pdf-view-forward-node () + (interactive) + (let ((outline (pdf-info-outline (current-buffer)))) + (if (not outline) (message "PDF has no outline") + (my-pdf-jump-and-set-current-node + (if (and my-pdf-view-current-node + (memq last-command my-pdf-view-navigation-functions)) + (my-pdf-view-next-node-by-node my-pdf-view-current-node outline) + (my-pdf-view-next-node-by-page outline)))))) + +(defun my-pdf-view-lowest-node-current-page (outline) + "returns the last node of the lowest depth on the current page" + (let ((result) (current-page (pdf-view-current-page))) + (catch 'ret + (while outline + (let ((node (car outline))) + (cond ((= (alist-get 'page node) current-page) + (when (or (not result) + (<= (alist-get 'depth node) + (alist-get 'depth result))) + (setq result node))) + ((> (alist-get 'page node) current-page) + (throw 'ret result)))) + (setq outline (cdr outline)))))) + +(defun my-pdf-view-highest-node-current-page (outline) + "returns the first node of the highest depth on the current page" + (let ((result) (current-page (pdf-view-current-page))) + (catch 'ret + (while outline + (let ((node (car outline))) + (cond ((= (alist-get 'page node) current-page) + (when (or (not result) + (> (alist-get 'depth node) + (alist-get 'depth result))) + (setq result node))) + ((> (alist-get 'page node) current-page) + (throw 'ret result)))) + (setq outline (cdr outline)))))) + +(defun my-pdf-view-forward-node-same-depth () + (interactive) + (let ((outline (pdf-info-outline (current-buffer)))) + (if (not outline) (message "PDF has no outline") + (my-pdf-jump-and-set-current-node + (my-pdf-view-next-node-by-node + (if (and my-pdf-view-current-node + (memq last-command my-pdf-view-navigation-functions)) + my-pdf-view-current-node + (my-pdf-view-lowest-node-current-page outline)) + outline 'same-depth))))) + +(defun my-pdf-view-prev-node-by-node (current-node outline &optional depth-req) + (let ((prev-node) (depth (alist-get 'depth current-node))) + (catch 'ret + (dolist (node outline) + (if (equal node current-node) + (throw 'ret prev-node) + (when (or (not depth-req) + (and (eq depth-req 'same-depth) + (eq (alist-get 'depth node) depth)) + (and (eq depth-req 'lower-depth) + (< (alist-get 'depth node) depth))) + (setq prev-node node))))))) + +(defun my-pdf-view-prev-node-by-page (outline) + (let ((prev-node)) + (catch 'ret + (dolist (node outline) + (if (>= (alist-get 'page node) (pdf-view-current-page)) + (throw 'ret prev-node) + (setq prev-node node)))))) + +(defun my-pdf-view-backward-node () + (interactive) + (let ((outline (pdf-info-outline (current-buffer)))) + (if (not outline) (message "PDF has no outline") + (my-pdf-jump-and-set-current-node + (if (and my-pdf-view-current-node + (memq last-command my-pdf-view-navigation-functions)) + (my-pdf-view-prev-node-by-node my-pdf-view-current-node outline) + (my-pdf-view-prev-node-by-page outline)))))) + +(defun my-pdf-view-backward-node-same-depth () + (interactive) + (let ((outline (pdf-info-outline (current-buffer)))) + (if (not outline) (message "PDF has no outline") + (my-pdf-jump-and-set-current-node + (my-pdf-view-prev-node-by-node + (if (and my-pdf-view-current-node + (memq last-command my-pdf-view-navigation-functions)) + my-pdf-view-current-node + (my-pdf-view-lowest-node-current-page outline)) + outline 'same-depth))))) + +(defun my-pdf-view-backward-node-lower-depth () + (interactive) + (let ((outline (pdf-info-outline (current-buffer)))) + (if (not outline) (message "PDF has no outline") + (my-pdf-jump-and-set-current-node + (my-pdf-view-prev-node-by-node + (if (and my-pdf-view-current-node + (memq last-command my-pdf-view-navigation-functions)) + my-pdf-view-current-node + (my-pdf-view-lowest-node-current-page outline)) + outline 'lower-depth))))) + +(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)) + +(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 new file mode 100644 index 0000000..6b7c705 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-prog.el @@ -0,0 +1,142 @@ +;;; my-prog.el -- Programming related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Programming related extensions for emacs core. Covers comint, +;; shell, eshell, elisp, prog-mode, c, c++, etc. + +;;; Code: + +;;; comint, shell, eshell +(defvar comint-buffer-list nil) +(setq display-buffer-alist + '(("\\*shell\\*.*" . (display-buffer-same-window)))) + +(defun my-shell-with-directory (dir) + "Starts a new shell with prompted directory as the cwd" + (interactive (list + (read-directory-name "Current dir: "))) + (let ((tmp-dir default-directory) + (old-buffer (current-buffer))) + (setq default-directory dir) + (shell (generate-new-buffer-name "*shell*")) + (with-current-buffer old-buffer (setq default-directory tmp-dir)))) + +(defun my-comint-send-input-and-return-prompt () + (interactive) + (comint-send-input) + (comint-previous-prompt 1) + (recenter 0 t)) + +;; FIXME: not working properly +(defun my-restart-shell () + (interactive) + (ignore-error (comint-send-eof)) + (shell (current-buffer)) + (message "Shell restarted!")) + +(defun my-shell-disable-company-if-remote () + (when (and (fboundp 'company-mode) + (file-remote-p default-directory)) + (company-mode -1))) + +(defun my-eshell-insert-prompt-prefix () + (interactive) + (let ((prompt (funcall eshell-prompt-function))) + (string-match "\\(^.*:\\).*$" prompt) + (when (match-string 1 prompt) + (insert (match-string 1 prompt))))) + +(defun my-eshell-send-input-and-return-prompt () + (interactive) + (eshell-send-input) + (eshell-previous-prompt 1)) + +;;; c +(defun my-c-set-compile-command () + (unless (file-exists-p "Makefile") + (setq compile-command + (let ((file (file-name-nondirectory buffer-file-name))) + (format "%s -o %s %s %s %s" + ;;"%s -c -o %s.o %s %s %s" + (or (getenv "CC") "gcc") + (file-name-sans-extension file) + (or (getenv "CPPFLAGS") "-DDEBUG=9") + (or (getenv "CFLAGS") + "-ansi -pedantic -Wall -g") + file))))) + +;;; To override `xref-query-replace-in-results'. +(defun my-xref-query-replace-in-results (from to) + "Perform interactive replacement of FROM with TO in all displayed xrefs. + +This function interactively replaces FROM with TO in the names of the +references displayed in the current *xref* buffer. + +When called interactively, it uses '.*' as FROM, which means replace +the whole name, and prompts the user for TO. +If invoked with prefix argument, it prompts the user for both FROM and TO. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + +Note that this function cannot be used in *xref* buffers that show +a partial list of all references, such as the *xref* buffer created +by \\[xref-find-definitions] and its variants, since those list only +some of the references to the identifiers." + (interactive + (let* ((fr + (if current-prefix-arg + (read-regexp "Query-replace (regexp)" ".*") + "\\(.*\\)")) + (prompt (if current-prefix-arg + (format "Query-replace (regexp) %s with: " fr) + "Query-replace all matches with: "))) + (list fr (read-regexp prompt)))) + (let* (item xrefs iter) + (save-excursion + (while (setq item (xref--search-property 'xref-item)) + (when (xref-match-length item) + (push item xrefs)))) + (unwind-protect + (progn + (goto-char (point-min)) + (setq iter (xref--buf-pairs-iterator (nreverse xrefs))) + (xref--query-replace-1 from to iter)) + (funcall iter :cleanup)))) + +(defun my-set-tab-width-to-8 () + (interactive) + (setq tab-width 8)) + +(defun my-toggle-debug-on-error-quit (arg) + (interactive "P") + (if arg + (toggle-debug-on-quit) + (toggle-debug-on-error)) + ) + +(provide 'my-prog) +;;; my-prog.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-project.el b/emacs/.emacs.d/lisp/my/my-project.el new file mode 100644 index 0000000..21a05f1 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-project.el @@ -0,0 +1,104 @@ +;;; my-project.el -- Project related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Project related extensions for emacs core. + +;;; Code: + + + +(defvar my-projects-root-dirs nil + "List of directories to look for projects. Each element in the form + of (tag . path). One of the tags should be \"3p\" which is a default + target for cloning a project") +(defun my-get-list-of-projects () + (flatten-list + (mapcar (lambda (pair) + (mapcar + (lambda (dir-name) (format "%s(%s)" dir-name (car pair))) + (directory-files + (cdr pair) nil directory-files-no-dot-files-regexp))) + my-projects-root-dirs))) + +(defun my-project-guess-project-name () + (file-name-nondirectory (directory-file-name + (project-root (project-current))))) + +(defvar my-licenses nil + "List of licenses in the form of (licence-id . license-text-file)") + +(defun my-project-copy-license-file-to-project (license) + (interactive (list (completing-read "License to copy to project root: " + (mapcar 'car my-licenses)))) + (let ((from (alist-get (intern license) my-licenses)) + (to (concat (project-root (project-current)) + "COPYING." license))) + (copy-file from to) + (message "Copied license of %s to %s" license to))) + +(defun my-project-remember-all-projects () + "Remember all projects under `my-projects-root-dirs'." + (pcase-dolist (`(_ . ,dir) my-projects-root-dirs) + (project-remember-projects-under dir))) +;; FIXME: do we really need this or does the project package already +;; do so? +(defun my-project-read-project () + (let ((key-val + (completing-read "Choose projects: " + (my-get-list-of-projects) nil t))) + (string-match "^\\(.*\\)(\\(.*\\))$" key-val) + (cons (match-string 2 key-val) (match-string 1 key-val)))) +(defun my-project-get-project-directory (pair) + (concat + (alist-get (car pair) my-projects-root-dirs nil nil 'string=) + "/" (cdr pair))) +(defun my-project-read-project-root () + (my-project-get-project-directory (my-project-read-project))) +(defun my-project-shell-at (arg) + (interactive "P") + (if arg (project-shell) + (my-shell-with-directory (my-project-read-project-root)))) +(defun my-project-dired-at (arg) + (interactive "P") + (if arg (project-dired) + (dired (my-project-read-project-root)))) +(defun my-project-rgrep-at (arg) + (interactive "P") + (if arg (project-query-replace-regexp) + (my-rgrep-at-directory (my-project-read-project-root)))) +(defun my-project-org-set-local-source () + (interactive) + (org-set-property "Local-source" (my-project-read-project-root))) +(defun my-project-code-stats () + (interactive) + (switch-to-buffer-other-window (get-buffer-create "*cloc*")) + (erase-buffer) + (my-with-default-directory (my-project-read-project-root) + (message default-directory) + (insert default-directory "\n") + (call-process "cloc" nil "*cloc*" nil "HEAD" "--quiet"))) + + +(provide 'my-project) +;;; my-project.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-rtliber.el b/emacs/.emacs.d/lisp/my/my-rtliber.el new file mode 100644 index 0000000..cefc5eb --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-rtliber.el @@ -0,0 +1,72 @@ +;;; my-rtliber.el -- Extensions for rt-liberation -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for rt-liberation. + +;;; Code: + + +(require 'rt-liberation) +;;; fixme: fsf credentials +(defun my-rt-liber-my-open-tickets () (interactive) + (rt-liber-browse-query + (format "owner = '%s' and status != 'resolved'" + rt-liber-username))) + +(defun my-rt-liber-my-tickets () (interactive) + (rt-liber-browse-query + (format "owner = '%s'" rt-liber-username))) + +(defun my-rt-liber-backlog () + (interactive) + (rt-liber-browse-query + "created >= '90 days ago' and owner = 'nobody' and status != 'resolved'")) + +(defun my-rt-liber-get-ticket-by-id (id) + (interactive "sTicket ID: ") (rt-liber-browse-query (concat "id = " + id))) + +(defun my-rt-liber-query-by-subject (query) + (interactive "sQuery in subject: ") + (rt-liber-browse-query + (concat "subject like '" query "'"))) + +;;; Used to override `rt-liber-viewer-visit-in-browser' +(defun my-rt-liber-viewer-visit-in-browser (&optional external) + "Visit this ticket section in the RT Web interface. +With a prefix arg, browse using secondary browser." + (interactive "P") + (let ((id (rt-liber-ticket-id-only rt-liber-ticket-local)) + (browser-function + (if external browse-url-secondary-browser-function + 'browse-url))) + (if id + (funcall browser-function + (concat rt-liber-base-url "Ticket/Display.html?id=" id + "#txn-" + (alist-get 'id (rt-liber-viewer2-get-section-data)))) + (error "no ticket currently in view")))) + +(provide 'my-rtliber) +;;; my-rtliber.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-scihub.el b/emacs/.emacs.d/lisp/my/my-scihub.el new file mode 100644 index 0000000..8d9f66b --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-scihub.el @@ -0,0 +1,53 @@ +;;; my-scihub.el -- scihub client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; scihub client. + +;;; Code: + + +(require 'link-gopher) + +(defvar my-scihub-host nil "Scihub host") +(defun my-get-scihub-pdf-link (doi) + (let ((link (car (link-gopher-get-all-links + (concat my-scihub-host doi) "\\.pdf$")))) + (when (not link) + (message "Scihub pdf link not found for %s with eww, trying firefox..." + doi) + (browse-url-firefox (concat my-scihub-host doi))) + link)) + +(defun my-download-scihub-doi (doi) + (interactive "sDOI: ") + (when-let ((link (my-get-scihub-pdf-link doi))) (wget link))) + +(defun my-org-attach-scihub () + (interactive) + (require 'org-attach) + (when-let ((doi (org-entry-get (point) "DOI"))) + (org-attach-url (my-get-scihub-pdf-link doi)))) + +(provide 'my-scihub) +;;; my-scihub.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-semantic-scholar.el b/emacs/.emacs.d/lisp/my/my-semantic-scholar.el new file mode 100644 index 0000000..4b22390 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-semantic-scholar.el @@ -0,0 +1,100 @@ +;;; my-semantic-scholar.el -- Semantic Scholar client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Semantic Scholar client. + +;;; Code: + +(require 'my-utils) +(require 'my-scihub) + +(defvar my-semantic-scholar-host + "https://api.semanticscholar.org/graph/v1") +(defun my-semantic-scholar-fetch-papers-for-completion (query) + (with-current-buffer + (url-retrieve-synchronously + (format "%s/paper/search?query=%s" my-semantic-scholar-host query)) + (my-skip-http-header) + (mapcar + (lambda (entry) + (concat + (alist-get 'title entry) + (propertize + (concat " " + (alist-get 'paperId entry)) + 'invisible t))) + (alist-get 'data (json-read))))) + +(defun my-semantic-scholar-make-paper-alist (paper-info) + (list (cons "Authors" + (string-join + (mapcar (lambda (entry) (alist-get 'name entry)) + (alist-get 'authors paper-info)) + " and ")) + (cons "Title" (alist-get 'title paper-info)) + (cons "Published" + (number-to-string (alist-get 'year paper-info))) + (cons "Abstract" (my-clean-property-value + (alist-get 'abstract paper-info))) + (cons "Venue" (alist-get 'venue paper-info)) + (cons "arXiv" (alist-get + 'ArXiv (alist-get 'externalIds paper-info))) + (cons "DOI" (alist-get + 'DOI (alist-get 'externalIds paper-info))) + (cons "Semantic-scholar" (alist-get 'paperId paper-info)))) + +(defun my-semantic-scholar-lookup-paper () + "looks up a paper using semantic scholar api, prompts for selection and creates a org entry." + (interactive) + (let* ((query (read-string "Query: ")) + (selected (completing-read + "Select paper:" ;; '("a" "b") + (my-semantic-scholar-fetch-papers-for-completion query)))) + (with-current-buffer + (url-retrieve-synchronously + (format + "%s/paper/%s?fields=title,abstract,authors,venue,year,externalIds" + my-semantic-scholar-host + (progn (string-match "^.* \\(.*\\)$" selected) + (match-string 1 selected)))) + (my-skip-http-header) + (my-org-create-node (my-semantic-scholar-make-paper-alist (json-read))) + (my-org-attach-scihub)))) + +(defun my-semantic-scholar-lookup-doi () + "looks up a paper using semantic scholar api, prompts for selection and creates a org entry." + (interactive) + (let ((doi (read-string "DOI: "))) + (with-current-buffer + (url-retrieve-synchronously + (format + "%s/paper/%s?fields=title,abstract,authors,venue,year,externalIds" + my-semantic-scholar-host + doi)) + (my-skip-http-header) + (my-org-create-node (my-semantic-scholar-make-paper-alist (json-read))) + (my-org-attach-scihub)))) + +(provide 'my-semantic-scholar) +;;; my-semantic-scholar.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-servall.el b/emacs/.emacs.d/lisp/my/my-servall.el new file mode 100644 index 0000000..81478e9 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-servall.el @@ -0,0 +1,39 @@ +;;; my-servall.el -- Extensions to servall -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions to servall. + +;;; Code: + + +(require 'org) +(require 'servall-wikipedia) +(defun my-servall-wikipedia-grok () + "grok from servall" + (interactive) + (org-protocol-grok + (list :url (format "https://en.wikipedia.org/wiki/%s" servall-wikipedia-title)))) + +(provide 'my-servall) +;;; my-servall.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-tempel.el b/emacs/.emacs.d/lisp/my/my-tempel.el new file mode 100644 index 0000000..c0834d4 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-tempel.el @@ -0,0 +1,68 @@ +;;; my-tempel.el -- Extensions for tempel -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Protesilaos Stavrou <info@protesilaos.com> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for tempel. + +;;; Code: + + +;;; taken from tempel info manual +(defun my-tempel-include (elt) + "A tempel element to include another element" + (when (eq (car-safe elt) 'i) + (if-let (template (alist-get (cadr elt) (tempel--templates))) + (cons 'l template) + (message "Template %s not found" (cadr elt)) + nil))) +(add-to-list 'tempel-user-elements #'my-tempel-include) + +;; Setup completion at point +(defun my-tempel-setup-capf () + ;; Add the Tempel Capf to `completion-at-point-functions'. + ;; `tempel-expand' only triggers on exact matches. Alternatively use + ;; `tempel-complete' if you want to see all matches, but then you + ;; should also configure `tempel-trigger-prefix', such that Tempel + ;; does not trigger too often when you don't expect it. NOTE: We add + ;; `tempel-expand' *before* the main programming mode Capf, such + ;; that it will be tried first. + (setq-local completion-at-point-functions + (cons #'tempel-expand + completion-at-point-functions))) + +;; Setup completion at point +(defun my-tempel-setup-capf () + ;; Add the Tempel Capf to `completion-at-point-functions'. + ;; `tempel-expand' only triggers on exact matches. Alternatively use + ;; `tempel-complete' if you want to see all matches, but then you + ;; should also configure `tempel-trigger-prefix', such that Tempel + ;; does not trigger too often when you don't expect it. NOTE: We add + ;; `tempel-expand' *before* the main programming mode Capf, such + ;; that it will be tried first. + (setq-local completion-at-point-functions + (cons #'tempel-expand + completion-at-point-functions))) + +(provide 'my-tempel) +;;; my-tempel.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-tide.el b/emacs/.emacs.d/lisp/my/my-tide.el new file mode 100644 index 0000000..58b2b8b --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-tide.el @@ -0,0 +1,43 @@ +;;; my-tide.el -- Extensions for tide -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for tide. + +;;; Code: + +(defun my-setup-tide-mode () + (interactive) + (tide-setup) + (flycheck-mode +1) + (setq flycheck-check-syntax-automatically '(save mode-enabled)) + (eldoc-mode +1) + (tide-hl-identifier-mode +1) + ;; company is an optional dependency. You have to + ;; install it separately via package-install + ;; `M-x package-install [ret] company` + (company-mode +1)) + +(provide 'my-tide) +;;; my-tide.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-time.el b/emacs/.emacs.d/lisp/my/my-time.el new file mode 100644 index 0000000..c1f2329 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-time.el @@ -0,0 +1,51 @@ +;;; my-time.el -- Time related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Time related extensions for emacs core. Covers time, date, diary, etc. + +;;; Code: + + + +;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. +(defun my-diary-offset (sexp days) + "Offsetted diary entry. +Entry applies if the date is DAYS days after another diary-sexp SEXP." + (with-no-warnings (defvar date) (defvar entry)) + (integerp days) + (let ((date + (calendar-gregorian-from-absolute + (- (calendar-absolute-from-gregorian date) days)))) + (eval sexp))) + +(defun my-appt-display-window (min-to-appt new-time appt-msg) + (or (listp min-to-appt) + (setq min-to-appt (list min-to-appt) + appt-msg (list appt-msg))) + (org-notify (format + "In %s minutes: %s" (car min-to-appt) (car appt-msg)))) + +(provide 'my-time) +;;; my-time.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-utils.el b/emacs/.emacs.d/lisp/my/my-utils.el new file mode 100644 index 0000000..7f36fae --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-utils.el @@ -0,0 +1,409 @@ +;;; my-utils.el -- Basic utilities used by other extensions -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Basic utilities used by other extensions. + +;;; Code: + + +;; time and date +(defun my-date-part (td) + (nthcdr 3 td)) + +(defun my-tomorrow () + (decode-time (time-add 86400 (current-time)))) + +(defun my-skip-http-header () + (goto-char (point-min)) + (re-search-forward "\r?\n\r?\n")) + +(defun my-seq-random-element (xs) + "Returns a random element of sequence." + (elt xs (random (length xs)))) + +(defun my-delete-http-header () + (delete-region (point-min) (progn (my-skip-http-header) (point)))) + +(defun my-get-current-line-no-properties () + (save-excursion + (let ((beg (progn (beginning-of-line) + (point))) + (end (progn (beginning-of-line 2) + (point)))) + (buffer-substring-no-properties beg (1- end))))) + +(defun my-sudo-find-file () + (interactive) + (let* ((maybe-filename (thing-at-point 'filename t)) + (matched (and maybe-filename + (string-match "^\\(.*/\\)\\(.*\\)$" maybe-filename))) + (file (read-file-name + "Open as root: " + (and matched (match-string 1 maybe-filename)) nil nil + (and matched (match-string 2 maybe-filename))))) + (unless (file-writable-p file) + (find-file (concat "/sudo::" file))))) + +(defvar my-url-regexp + (concat + "~?\\<\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]*\\)" + "[.@]" + "\\([-a-zA-Z0-9+&@#/%?=~_|!:,.;]+\\)\\>/?") + "Regular expression to match (most?) URLs or email addresses.") + + +(defun my-clean-property-value (value) + (when value + (replace-regexp-in-string + "\n" ", " + (string-trim (replace-regexp-in-string " " "_" value) + "[ \t\n\r_]+" "[ \t\n\r_]+")))) + +;; rewriting urls +(defvar my-max-url-rewrite 100 "Max number of URL redirect") +(defun my-rewrite-url (url) + (let ((new-url url) + (tmp-url) + (i 0)) + (catch 'done + (while (< i my-max-url-rewrite) + (setq tmp-url (my-rewrite-url-once new-url)) + (when (equal tmp-url new-url) (throw 'done nil)) + (setq new-url tmp-url + i (1+ i)))) + (unless (equal url new-url) + (message "Rewriting %s to %s" url new-url)) + new-url)) + +(defvar my-simple-url-rewrites + '((:name http-to-https + :description "Rewrite http to https." + :from "^http://\\(.*\\)$" + :to "https://%s" + :parts (1)) + (:name ddg-result + :description "duckduckgo result transform." + :from "^https://duckduckgo.com/l/\\?uddg=\\(.*\\)&rut=.*$" + :to "%s" + :parts (1) + :match-processor url-unhex-string) + (:name youtube-to-yewtu-be + :description "youtube to yewtu.be" + :from "^https://\\(www\\.\\)?youtube.com/\\(.*\\)$" + :to "https://yewtu.be/%s" + :parts (2)) + (:name reddit-to-teddit + :description "Reddit to Teddit" + :from "^https://\\(www\\.\\|old\\.\\)?reddit.com/\\(.*\\)$" + :to "https://teddit.net/%s" + :parts (2)) + (:name twitter-to-nitter + :description "Twitter to nitter." + :from "^https://twitter.com/\\(.*\\)$" + :to "https://nitter.eu/%s" + :parts (1)) + (:name google-to-ddg + :description "Google to duckduckgo" + :from "^https://www.google.com/search\\?q=\\(.*\\)$" + :to "https://html.duckduckgo.com/html?q=%s" + :parts (1)) + (:name php-manual-to-english + :descripton "PHP manual to English" + :from "^https://www.php.net/manual/../\\(.*\\)$" + :to "https://www.php.net/manual/en/%s" + :parts (1)) + (:name google-sheets-to-csv + :description "Google sheets to csv" + :from "https://docs.google.com/spreadsheets/\\(.*\\)/.*" + :to "https://docs.google.com/spreadsheets/%s/export?format=csv" + :parts (1)) + (:name google-docs-to-odt + :description "Google docs to odt" + :from "https://docs.google.com/document/\\(.*\\)/.*" + :to "https://docs.google.com/document/%s/export?format=odt" + :parts (1)) + (:name utm-remover-not-last + :description "Removing a utm_foo query that is not the last query" + :from "\\(.*\\)\\butm_[a-z_]+=[^&]*&\\(.*\\)" + :to "%s%s" + :parts (1 2)) + (:name utm-remover-last + :description "Removing a utm_foo query that is the last query" + :from "\\(.*\\)[&?]utm_[a-z_]+=[^#]*\\(.*\\)" + :to "%s%s" + :parts (1 2)))) + +(defun my-simple-rewrite-function-name (data) + (intern (format "my-simple-url-rewrite-%s" + (plist-get data :name)))) + +(defmacro my-def-simple-rewrite (data) + (let ((processor (plist-get data :match-processor))) + `(defun ,(my-simple-rewrite-function-name data) (url) + ,(plist-get data :description) + (when (string-match ,(plist-get data :from) url) + ,(append `(format ,(plist-get data :to)) + (mapcar (lambda (part) + (if processor + `(,processor (match-string ,part url)) + `(match-string ,part url))) + (plist-get data :parts))))))) + +;; TODO: why do we need an eval here? +;; Because we are using plist-get in the defmacro +(dolist (data my-simple-url-rewrites) + (eval `(my-def-simple-rewrite ,data))) + +(defvar my-url-rewrite-functions + (mapcar 'my-simple-rewrite-function-name my-simple-url-rewrites)) + +(defun my-rewrite-url-once (url) + (let* ((rewriters my-url-rewrite-functions) + (rewritten) (rewriter) (result)) + (while (and rewriters (not rewritten)) + (setq rewriter (car rewriters) + rewriters (cdr rewriters) + rewritten (funcall rewriter url))) + (or rewritten url))) + +(defun my-shell-command-output (command) + (let ((inhibit-message t)) + (if (= 0 + (shell-command command)) + (with-current-buffer shell-command-buffer-name + (string-trim (buffer-string))) + (error (with-current-buffer shell-command-buffer-name + (string-trim (buffer-string))))))) + +;; mailman utils +(defun my-mailman-to-listinfo-url (url) + (when (string-match "^\\(.*\\)/archive/html/\\(.*\\)" url) + (format "%s/mailman/listinfo/%s" + (match-string 1 url) (match-string 2 url)))) + +(defun my-mailman-to-archive-url (url) + (when (string-match "^\\(.*\\)/mailman/listinfo/\\(.*\\)" url) + (format "%s/archive/html/%s" + (match-string 1 url) (match-string 2 url)))) + +;; filenames + +(defun my-make-filename (name &optional sep) + "Convert name to filename by replacing special chars with sep." + (unless sep (setq sep "-")) + (replace-regexp-in-string "[[:punct:][:space:]\n\r]+" sep + (string-trim name))) + +(defun my-make-filename-from-url (url) + (let* ((urlobj (url-generic-parse-url url)) + (filename (url-filename urlobj)) + (host (url-host urlobj))) + (replace-regexp-in-string + "^-+" "" + (replace-regexp-in-string + "-+$" "" (my-make-filename (concat host "-" filename)))))) + +(defun my-clean-property-key (key) + (when key + (let ((new-key + (replace-regexp-in-string + "[ \t\n\r_]+" "-" (string-trim + (replace-regexp-in-string " " "_" key))))) + (cond ((string-match "Publication-date" new-key) + "Published") + ((string= new-key "Publication") "Published") + ((string= new-key "出版時間") "Published") + ((string= new-key "出生") "Born") + ((string= new-key "逝世") "Died") + ((string= new-key "Formed") "Founded") + ((string-match "^成立" new-key) "Founded") + ((string= new-key "网站") "Website") + ((string= new-key "網站") "Website") + ((string= new-key "出版日期") "Published") + ((string= new-key "Author") "Authors") + ((string= new-key "作者") "Authors") + ((string= new-key "Designer") "Designers") + ((string-match "Directed" new-key) "Director") + ((string= new-key "Created-by") "Director") + ((string-match "导演" new-key) "Director") + ((string-match "[Rr]elease-date" new-key) "Released") + ((string-match "上映日期" new-key) "Released") + ((string-match "[Oo]riginal-release" new-key) "Released") + ((string-match "[Ii]nitial-release" new-key) "Released") + ((string-match "^Release$" new-key) "Released") + ((string-match "^Developer" new-key) "Developers") + ((string-match "^Repository" new-key) "Source") + ((string-match "^URL" new-key) "Website") + ((string-match "^Official-website" new-key) "Website") + (t new-key))))) + +(defun my-parse-colon-separated-output (buffer) + (with-current-buffer buffer + (goto-char (point-min)) + (let ((result) (field) (value)) + (while (not (eobp)) + (if (re-search-forward "\\(.*?\\)\\ +:" nil t) + (progn + (setq field + (replace-regexp-in-string + "[()]" "" + (replace-regexp-in-string "\\ " "-" (match-string 1)))) + (re-search-forward "\\ *\\(.*?\\)\n") + (setq value (match-string 1)) + (push (cons field value) result)) + (message "Failed search in parsing!") + (goto-char (point-max)))) + result))) + +(defvar my-docs-root-dir nil "Root directory of documentation") +(defun my-get-list-of-docs () + (directory-files my-docs-root-dir nil directory-files-no-dot-files-regexp)) + +(defmacro my-with-default-directory (dir &rest body) + "Run BODY with the default directory." + (declare (indent 1) (debug t)) + `(let ((saved default-directory)) + (setq default-directory ,dir) + ,@body + (setq default-directory saved))) + +(defun my-call-process-with-torsocks + (program &optional infile destination display &rest args) + (apply 'call-process + (append (list "torsocks" infile destination display program) args))) + +(defun my-start-process-with-torsocks (no-tor name buffer program &rest program-args) + (if no-tor + (apply 'start-process (append (list name buffer program) program-args)) + (apply 'start-process + (append (list name buffer "torsocks" program) program-args)))) + +(defun my-touch-new-file (filename) + "Touch a new file." + (with-temp-buffer (write-file filename))) + +(defvar my-extension-types + '((audio . ("asf" "cue" "flac" "m4a" "m4r" "mid" "mp3" "ogg" "opus" + "wav" "wma")) + (video . ("avi" "m4v" "mkv" "mp4" "mpg" "ogg" "ogv" "rmvb" "webm" "wmv")))) + +;;; files +(defun my-rename-and-symlink-back (file newname ok-if-already-exists) + (when (directory-name-p newname) + (setq newname (concat newname (file-name-nondirectory file)))) + (rename-file file newname ok-if-already-exists) + (make-symbolic-link newname file ok-if-already-exists) + newname) + +(defun my-rewrite-url-advice (args) + (let ((url (car args))) + (setcar args (my-rewrite-url url))) + args) + +(defun my-server-p () + "nonnil if the emacs is a server or daemon" + (and (boundp 'server-process) server-process)) + +;; cleaning utilities +(defun my-extract-year (text) + (if (string-match "\\([0-9]\\{4\\}\\)" text) + (match-string 1 text) + "")) + +(defun my-rename-file-and-buffer (name) + "Apply NAME to current file and rename its buffer. +Do not try to make a new directory or anything fancy." + (interactive + (list (read-file-name "Rename current file to: "))) + (let ((file (buffer-file-name))) + (if (vc-registered file) + (vc-rename-file file name) + (rename-file file name)) + (set-visited-file-name name t t))) + +(defun my-delete-file-and-kill-buffer () + "Delete the buffer and the file + +Only accept if the file is vc-registered (easy to recover from mistakes)" + (interactive) + (let ((file (buffer-file-name))) + (unless (vc-registered file) + (error "Cannot delete file not under vc")) + (vc-revert-file file) + (vc-refresh-state) + (vc-delete-file file)) + (kill-buffer)) + +;;; Some of the following functions are adapted from prot-dotfiles +;;;###autoload +(defun my-keyboard-quit-dwim () + "Do-What-I-Mean behaviour for a general `keyboard-quit'. + +The generic `keyboard-quit' does not do the expected thing when +the minibuffer is open. Whereas we want it to close the +minibuffer, even without explicitly focusing it. + +The DWIM behaviour of this command is as follows: + +- When the region is active, disable it. +- When a minibuffer is open, but not focused, close the minibuffer. +- When the Completions buffer is selected, close it. +- In every other case use the regular `keyboard-quit'." + (interactive) + (cond + ((region-active-p) + (keyboard-quit)) + ((derived-mode-p 'completion-list-mode) + (delete-completion-window)) + ((> (minibuffer-depth) 0) + (abort-recursive-edit)) + (t + (keyboard-quit)))) + +;; The `my-line-regexp-p' and `my--line-regexp-alist' +;; are contributed by Gabriel: <https://github.com/gabriel376>. +(defvar my--line-regexp-alist + '((empty . "[\s\t]*$") + (indent . "^[\s\t]+") + (non-empty . "^.+$") + (list . "^\\([\s\t#*+]+\\|[0-9]+[^\s]?[).]+\\)") + (heading . "^[=-]+")) + "Alist of regexp types used by `my-line-regexp-p'.") + +(defun my-line-regexp-p (type &optional n) + "Test for TYPE on line. +TYPE is the car of a cons cell in +`my--line-regexp-alist'. It matches a regular +expression. + +With optional N, search in the Nth line from point." + (save-excursion + (goto-char (line-beginning-position)) + (and (not (bobp)) + (or (beginning-of-line n) t) + (save-match-data + (looking-at + (alist-get type my--line-regexp-alist)))))) + +(provide 'my-utils) diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el new file mode 100644 index 0000000..c8517de --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-web.el @@ -0,0 +1,129 @@ +;;; my-web.el -- web related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; web related extensions for emacs core. Covers eww etc. + +;;; Code: + + + +(defun my-eww-next-path () + (interactive) + (let ((url (plist-get eww-data :url))) + (when (string-match "^\\(.*?\\)\\([0-9]+\\)\\(.*\\)$" url) + (eww (concat + (match-string 1 url) + (number-to-string + (1+ (string-to-number (match-string 2 url)))) + (match-string 3 url)))))) + +(defun my-eww-prev-path () + (interactive) + (let ((url (plist-get eww-data :url))) + (when (string-match "^\\(.*\\)\\([0-9]+\\)\\(.*\\)$" url) + (eww (concat + (match-string 1 url) + (number-to-string + (1- (string-to-number (match-string 2 url)))) + (match-string 3 url)))))) + +(defun my-eww-up-path () + (interactive) + (let ((url (plist-get eww-data :url))) + (when (and (string-match "^\\(.*//.*/\\)[^/]+\\(/\\)?$" url) + (match-string 1 url)) + (eww (match-string 1 url))))) + +(defun my-eww-top-path () + (interactive) + (let ((url (plist-get eww-data :url))) + (when (and (string-match "^\\(.*//.*?/\\).*$" url) + (match-string 1 url)) + (eww (match-string 1 url))))) + +(defun my-browse-url-tor-browser (url) + "Browse URL with tor-browser." + (setq url (browse-url-encode-url url)) + (start-process (concat "tor-browser " url) nil "tor-browser" + "--allow-remote" url)) + +(defun my-browse-url-firefox-private (url) + "Browse URL in a private firefox window." + (setq url (browse-url-encode-url url)) + (start-process (concat "firefox-private " url) nil "firefox" + "--private-window" 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)) + +;; override eww-copy-page-url to work with bookmark id frags. +(defun eww-copy-page-url () + "Copy the URL of the current page into the kill ring." + (interactive) + (let* ((url (plist-get eww-data :url)) + (id (get-text-property (point) 'shr-frag-id)) + (url-no-frag + (if (string-match "^\\(.*\\)#.*$" url) + (match-string 1 url) + url)) + (final-url + (if id (concat url-no-frag "#" id) + url)) + ) + (message "%s" final-url) + (kill-new final-url))) + +(defun my-eww-switch-by-title (title-and-buffer) + "Switches to an eww buffer with selected title." + (interactive + (list + (let ((com-table)) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (equal major-mode 'eww-mode) + (add-to-list + 'com-table + (concat (plist-get eww-data :title) + (propertize (concat " " (buffer-name)) + 'invisible t)))))) + (completing-read "Eww buffer title: " com-table)))) + (string-match "^.* \\(.*\\)$" title-and-buffer) + (switch-to-buffer (match-string 1 title-and-buffer))) + +(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 new file mode 100644 index 0000000..5349257 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-wget.el @@ -0,0 +1,79 @@ +;;; my-wget.el -- Extensions for emacs-wget -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extensions for emacs-wget. + +;;; Code: + + +;; wget +(require 'wget) +(require 'my-utils) +(defvar my-wget-video-archive-directory) +;; FIXME: this list is rather random... +(setq my-wget-video-extensions '("mp4" "flv" "mkv" "webm" "ogv" "avi" + "rmvb")) +(defun my-wget-ensure-buffer-exists () + (get-buffer-create (or wget-process-buffer " *wget*"))) +(defun my-eww-wget-save-page () + (interactive) + (my-wget-ensure-buffer-exists) + (let* ((filename + (concat (my-make-filename (plist-get eww-data :title)) ".html")) + (full-path (concat wget-download-directory "/" filename))) + (wget-uri (plist-get eww-data :url) + wget-download-directory + (list (concat "-O" filename))) + (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) + (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)))) + +(defun wget-async-urls-with-prefix (urls prefix &optional no-tor move-if-video-or-large) + (let ((i 1)) + (dolist (url urls) + (my-wget-async + url + (concat prefix + (make-string (- 4 (length (number-to-string i))) ?0) + (number-to-string i) + "." (file-name-extension url)) + no-tor move-if-video-or-large) + (setq i (1+ i))))) + +(provide 'my-wget) +;;; my-wget.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-wikipedia.el b/emacs/.emacs.d/lisp/my/my-wikipedia.el new file mode 100644 index 0000000..557c553 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-wikipedia.el @@ -0,0 +1,182 @@ +;;; my-wikipedia.el -- wikipedia client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; wikipedia client. + +;;; Code: + + +(require 'my-utils) +(require 'my-markup) +(require 'my-net) + +;; TODO: much of these can be generalised to any mediawiki site +(defvar my-wikipedia-lang "en") +(defvar my-wikipedia-host + (format "https://%s.wikipedia.org" my-wikipedia-lang)) +(defun my-grok-wikipedia (url) + "groks wikipedia by url and returns the info of the wikipedia entry." + (with-current-buffer (url-retrieve-synchronously url) + (my-delete-http-header) + (goto-char (point-min)) + (let ((results (my-grok-wikipedia-get-imdb-rating)) + (html + (libxml-parse-html-region (point-min) (point-max)))) + (append (my-grok-wikipedia-html html url) results)))) + +(defun my-grok-wikipedia-get-imdb-rating () + (when (re-search-forward + "\\(https://\\(www\\.\\)?imdb.com/title/tt[0-9]+/\\)" nil t) + (let ((url (match-string 1))) + (with-current-buffer (url-retrieve-synchronously + (concat url "ratings")) + (goto-char (point-min)) + (when + (re-search-forward + "\\([0-9,]+\\)\\s-*IMDb.*?\\([0-9\\.]+\\) / 10" nil t) + (list (cons "IMDB-link" url) + (cons "IMDB-rating" (match-string 2)) + (cons "IMDB-rated-by" (match-string 1)))))))) + +(defun my-wikipedia-api-summary (title) + (my-url-fetch-json + (format "%s/api/rest_v1/page/summary/%s" my-wikipedia-host title))) + +(defun my-grok-wikipedia-summary (url) + "get wikipedia summary using the rest api" + (let ((resp (my-wikipedia-api-summary + (replace-regexp-in-string ".*/wiki/" "" url)))) + (list (cons "Wikipedia-link" + (alist-get 'page + (alist-get 'desktop + (alist-get 'content_urls resp)))) + (cons "Description" (my-clean-property-value + (alist-get 'extract resp))) + (cons "Title" (alist-get 'title resp)) + (cons "Cover" (alist-get 'source + (alist-get 'thumbnail resp))) + (cons "Latitude" (when-let (coord (alist-get 'coordinates resp)) + (number-to-string (alist-get 'lat coord)))) + (cons "Longitude" (when-let (coord (alist-get 'coordinates resp)) + (number-to-string + (alist-get 'lon coord))))))) +(defun my-grok-wikipedia-html (html url) + (let* ((result (my-grok-wikipedia-summary url)) + (info (car (dom-by-class html "infobox"))) + (ths (dom-by-tag info 'th)) + (tds (mapcar (lambda (th) + (my-dom-remove-style + (car (dom-by-tag (dom-parent info th) 'td)))) + ths)) + (len (length ths))) + (dotimes (unused len) + (let* ((key (my-clean-property-key + (dom-texts (pop ths) ""))) + (value (my-clean-property-value + (dom-texts (pop tds) ""))) + (to-push + (cond ((string-empty-p key) nil) + ((string-empty-p value) nil) + ((string= key "Coordinates") + (my-grok-wikipedia-clean-coordinates value)) + ((or (member key '("Website" "Source" "URL"))) + (list (cons key (my-grok-wikipedia-fix-url value)))) + (t (list (cons key value)))))) + (mapc (lambda (pair) (push pair result)) to-push))) + (reverse result))) +(defun my-grok-wikipedia-clean-coordinates (raw) + (let ((float-re "\\([-+]?[0-9]+\\(?:\\.[0-9]*\\)?\\)")) + (string-match (format "%s; %s$" float-re float-re) raw) + (list (cons "Latitude" (match-string 1 raw)) + (cons "Longitude" (match-string 2 raw))))) + +(defun my-grok-wikipedia-fix-url (url) + (let* ((urlobj (url-generic-parse-url url)) + (filename (url-filename urlobj))) + (unless (url-type urlobj) + (setf (url-type urlobj) "https") + (string-match "^\\([^/]+\\)\\(/.*\\)?$" filename) + (setf (url-host urlobj) (match-string 1 filename)) + (setf (url-filename urlobj) (or (match-string 2 filename) "")) + (setf (url-fullness urlobj) t)) + (url-recreate-url urlobj))) + +(defun my-wikipedia-api-search (query) + (my-url-fetch-json + (format + "%s/w/api.php?action=query&format=json&list=search&srsearch=%s" + my-wikipedia-host query))) + +(defun my-wikipedia-search (query) + (interactive "sQuery: ") + (generic-search-open + (alist-get 'search + (alist-get 'query + (my-wikipedia-api-search query))) + (format "wikipedia-query:%s" query) + `((formatter . my-wikipedia-format-result) + (default-action . my-wikipedia-grok-action) + (keymap . ,my-wikipedia-button-keymap)))) + +(defun my-wikipedia-format-result (result) + (concat + (format "%s (%d words)" + (alist-get 'title result) + (alist-get 'wordcount result)) + (propertize + (format "\n\n%s" + (my-wikipedia-highlight-snippet-matches + (alist-get 'snippet result))) + 'face 'default))) + +(defun my-wikipedia-highlight-snippet-matches (snippet) + (with-temp-buffer + (insert snippet) + (goto-char (point-min)) + (while (re-search-forward "<span class=\"searchmatch\">\\(.*?\\)</span>" nil t) + (replace-match + (propertize (match-string 1) 'face 'match))) + (buffer-string))) + +(defun my-wikipedia-grok-action (info) + (interactive) + (my-org-grok (format "%s/wiki/%s" + my-wikipedia-host + (alist-get 'title info)))) + +(defun my-wikipedia-fetch-wiki () + (interactive) + (my-fetch-url (format "/wiki/%s?action=raw" + my-wikipedia-host + (alist-get 'title + (get-text-property (point) 'button-data))))) + +(defvar my-wikipedia-button-keymap + (let ((kmap (make-sparse-keymap))) + (set-keymap-parent kmap button-map) + (define-key kmap "f" 'my-wikipedia-fetch-wiki) + kmap)) + +(provide 'my-wikipedia) +;;; my-wikipedia.el ends here diff --git a/emacs/.emacs.d/lisp/my/my-ytdl.el b/emacs/.emacs.d/lisp/my/my-ytdl.el new file mode 100644 index 0000000..0571682 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-ytdl.el @@ -0,0 +1,78 @@ +;;; my-ytdl.el -- ytdl client -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei <id@ypei.org> +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles 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. + +;; dotfiles 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 dotfiles. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; ytdl client. Works with youtube-dl, yt-dlp etc. + +;;; Code: + + +(defvar my-ytdl-program "yt-dlp") + +(defvar my-ytdl-video-args + '("--download-archive" "yt-dlp-archive" "-o" +;; "%(id)s.%(ext)s" ;; for long names + "%(playlist|.)s/%(playlist_index|)s%(playlist_index&-|)s%(title)s.%(ext)s" + ;; https://github.com/yt-dlp/yt-dlp/issues/5630 + "-f" "bv*[height<=?720]+ba/best[height<=?720]" + "--write-subs" "--sub-langs" "en" + "--write-description" + "--write-thumbnail")) + +(defvar my-ytdl-video-download-dir "~/Downloads" + "Directory for ytdl to download videos to.") + +(defvar my-ytdl-audio-args + '("-x" "--download-archive" "yt-dlp-archive" "-o" + ;; "%(id)s.%(ext)s" ;; for long names + "%(playlist|.)s/%(playlist_index|)s%(playlist_index&-|)s%(title)s.%(ext)s" + "--write-description" + "--write-thumbnail")) + +(defvar my-ytdl-audio-download-dir "~/Downloads" + "Directory for ytdl to download audios to.") + +(defun my-ytdl-internal (urls type &optional cut-segments) + (my-with-default-directory (if (eq type 'video) + my-ytdl-video-download-dir + my-ytdl-audio-download-dir) + (apply 'my-start-process-with-torsocks + (append + (list nil (format "ytdl-%s" urls) (format "*ytdl-%s*" urls) + my-ytdl-program) + (if (eq type 'video) my-ytdl-video-args my-ytdl-audio-args) + (split-string urls))))) + +;;; fixme: autoload +(defun my-ytdl-video (urls) + "Download videos with ytdl." + (interactive "sURL(s): ") + (my-ytdl-internal urls 'video)) + +(defun my-ytdl-audio (urls) + "Download audio with ytdl." + (interactive "sURL(s): ") + (my-ytdl-internal urls 'audio)) + +(provide 'my-ytdl) +;;; my-ytdl.el ends here diff --git a/emacs/.emacs.d/lisp/my/radix-tree.el b/emacs/.emacs.d/lisp/my/radix-tree.el new file mode 100644 index 0000000..f001198 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/radix-tree.el @@ -0,0 +1,258 @@ +;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; NOTE: This is a modified version of radix-tree that comes builtin +;; with emacs. It allows different compare functions and type. One use +;; is to build a radix tree of list of string, e.g. from a filesystem +;; hierarchy. + +;; There are many different options for how to represent radix trees +;; in Elisp. Here I chose a very simple one. A radix-tree can be either: +;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string +;; meaning that everything that starts with PREFIX is in PTREE, +;; and everything else in RTREE. It also has the property that +;; everything that starts with the first letter of PREFIX but not with +;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all). +;; - anything else is taken as the value to associate with the empty string. +;; So every node is basically an (improper) alist where each mapping applies +;; to a different leading letter. +;; +;; The main downside of this representation is that the lookup operation +;; is slower because each level of the tree is an alist rather than some kind +;; of array, so every level's lookup is O(N) rather than O(1). We could easily +;; solve this by using char-tables instead of alists, but that would make every +;; level take up a lot more memory, and it would make the resulting +;; data structure harder to read (by a human) when printed out. + +;;; Code: +(defvar radix-tree-compare-function 'compare-strings) +(defvar radix-tree-type 'string) + +(defun radix-tree--insert (tree key val i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (funcall radix-tree-compare-function prefix nil nil key i ni))) + (if (eq t cmp) + (let ((nptree (radix-tree--insert ptree key val ni))) + `((,prefix . ,nptree) . ,rtree)) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--insert rtree key val i))) + `((,prefix . ,ptree) . ,nrtree)) + (let* ((nprefix (substring prefix 0 n)) + (kprefix (substring key (+ i n))) + (pprefix (substring prefix n)) + (ktree (if (equal kprefix "") val + `((,kprefix . ,val))))) + `((,nprefix + . ((,pprefix . ,ptree) . ,ktree)) + . ,rtree))))))) + (_ + (if (= (length key) i) val + (let ((prefix (substring key i))) + `((,prefix . ,val) . ,tree)))))) + +(defun radix-tree--remove (tree key i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (funcall radix-tree-compare-function prefix nil nil key i ni))) + (if (eq t cmp) + (pcase (radix-tree--remove ptree key ni) + ('nil rtree) + (`((,pprefix . ,pptree)) + `((,(seq-concatenate radix-tree-type prefix pprefix) . ,pptree) . + ,rtree)) + (nptree `((,prefix . ,nptree) . ,rtree))) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--remove rtree key i))) + `((,prefix . ,ptree) . ,nrtree)) + tree))))) + (_ + (if (= (length key) i) nil tree)))) + + +(defun radix-tree--lookup (tree string i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (funcall radix-tree-compare-function prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--lookup ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (radix-tree--lookup rtree string i) + (+ i n)))))) + (val + (if (and val (equal (length string) i)) + (if (integerp val) `(t . ,val) val) + i)))) + +;; (defun radix-tree--trim (tree string i) +;; (if (= i (length string)) +;; tree +;; (pcase tree +;; (`((,prefix . ,ptree) . ,rtree) +;; (let* ((ni (+ i (length prefix))) +;; (cmp (funcall radix-tree-compare-function prefix nil nil string i ni)) +;; ;; FIXME: We could compute nrtree more efficiently +;; ;; whenever cmp is not -1 or 1. +;; (nrtree (radix-tree--trim rtree string i))) +;; (if (eq t cmp) +;; (pcase (radix-tree--trim ptree string ni) +;; (`nil nrtree) +;; (`((,pprefix . ,pptree)) +;; `((,(concat prefix pprefix) . ,pptree) . ,nrtree)) +;; (nptree `((,prefix . ,nptree) . ,nrtree))) +;; (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) +;; (cond +;; ((equal (+ n i) (length string)) +;; `((,prefix . ,ptree) . ,nrtree)) +;; (t nrtree)))))) +;; (val val)))) + +(defun radix-tree--prefixes (tree string i prefixes) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (funcall radix-tree-compare-function prefix nil nil string i ni)) + ;; FIXME: We could compute prefixes more efficiently + ;; whenever cmp is not -1 or 1. + (prefixes (radix-tree--prefixes rtree string i prefixes))) + (if (eq t cmp) + (radix-tree--prefixes ptree string ni prefixes) + prefixes))) + (val + (if (null val) + prefixes + (cons (cons (substring string 0 i) + (if (eq (car-safe val) t) (cdr val) val)) + prefixes))))) + +(defun radix-tree--subtree (tree string i) + (if (equal (length string) i) tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (funcall radix-tree-compare-function prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--subtree ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (cond + ((zerop n) (radix-tree--subtree rtree string i)) + ((equal (+ n i) (length string)) + (let ((nprefix (substring prefix n))) + `((,nprefix . ,ptree)))) + (t nil)))))) + (_ nil)))) + +;;; Entry points + +(defconst radix-tree-empty nil + "The empty radix-tree.") + +(defun radix-tree-insert (tree key val) + "Insert a mapping from KEY to VAL in radix TREE." + (when (consp val) (setq val `(t . ,val))) + (if val (radix-tree--insert tree key val 0) + (radix-tree--remove tree key 0))) + +(defun radix-tree-lookup (tree key) + "Return the value associated to KEY in radix TREE. +If not found, return nil." + (pcase (radix-tree--lookup tree key 0) + (`(t . ,val) val) + ((pred numberp) nil) + (val val))) + +(defun radix-tree-subtree (tree string) + "Return the subtree of TREE rooted at the prefix STRING." + (radix-tree--subtree tree string 0)) + +;; (defun radix-tree-trim (tree string) +;; "Return a TREE which only holds entries \"related\" to STRING. +;; \"Related\" is here defined as entries where there's a `string-prefix-p' relation +;; between STRING and the key." +;; (radix-tree-trim tree string 0)) + +(defun radix-tree-prefixes (tree string) + "Return an alist of all bindings in TREE for prefixes of STRING." + (radix-tree--prefixes tree string 0 nil)) + +(pcase-defmacro radix-tree-leaf (vpat) + "Pattern which matches a radix-tree leaf. +The pattern VPAT is matched against the leaf's carried value." + ;; We used to use `(pred atom)', but `pcase' doesn't understand that + ;; `atom' is equivalent to the negation of `consp' and hence generates + ;; suboptimal code. + `(or `(t . ,,vpat) (and (pred (not consp)) ,vpat))) + +(defun radix-tree-iter-subtrees (tree fun) + "Apply FUN to every immediate subtree of radix TREE. +FUN is called with two arguments: PREFIX and SUBTREE. +You can test if SUBTREE is a leaf (and extract its value) with the +pcase pattern (radix-tree-leaf PAT)." + (while tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (funcall fun prefix ptree) + (setq tree rtree)) + (_ (funcall fun "" tree) + (setq tree nil))))) + +(defun radix-tree-iter-mappings (tree fun &optional prefix) + "Apply FUN to every mapping in TREE. +FUN is called with two arguments: KEY and VAL. +PREFIX is only used internally." + (radix-tree-iter-subtrees + tree + (lambda (p s) + (let ((nprefix (seq-concatenate radix-tree-type prefix p))) + (pcase s + ((radix-tree-leaf v) (funcall fun nprefix v)) + (_ (radix-tree-iter-mappings s fun nprefix))))))) + +;; (defun radix-tree->alist (tree) +;; (let ((al nil)) +;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al))) +;; al)) + +(defun radix-tree-count (tree) + (let ((i 0)) + (radix-tree-iter-mappings tree (lambda (_k _v) (setq i (1+ i)))) + i)) + +(declare-function map-apply "map" (function map)) + +(defun radix-tree-from-map (map) + ;; Aka (cl-defmethod map-into (map (type (eql 'radix-tree)))) ...) + (require 'map) + (let ((rt nil)) + (map-apply (lambda (k v) (setq rt (radix-tree-insert rt k v))) map) + rt)) + +(provide 'radix-tree) +;;; radix-tree.el ends here diff --git a/emacs/.emacs.d/lisp/nov.el b/emacs/.emacs.d/lisp/nov.el new file mode 160000 +Subproject b3c7cc28e95fe25ce7b443e5f49e2e45360944a diff --git a/emacs/.emacs.d/lisp/org-recoll b/emacs/.emacs.d/lisp/org-recoll new file mode 160000 +Subproject 7c4b229090fac051a27756bddfd5e8da1f7ea21 diff --git a/emacs/.emacs.d/lisp/pactl.el b/emacs/.emacs.d/lisp/pactl.el new file mode 160000 +Subproject ce49297aa5e143433cf81d17ef27e835b8c22ab diff --git a/emacs/.emacs.d/lisp/s.el b/emacs/.emacs.d/lisp/s.el new file mode 160000 +Subproject 08661efb075d1c6b4fa812184c1e5e90c08795a diff --git a/emacs/.emacs.d/lisp/servall b/emacs/.emacs.d/lisp/servall new file mode 160000 +Subproject 975d135d52270f3d0f31c3aa06a892f478244c7 diff --git a/emacs/.emacs.d/lisp/sx.el b/emacs/.emacs.d/lisp/sx.el new file mode 160000 +Subproject ca11c10040e1499a3cb66b21d6df12dca9adf0d diff --git a/emacs/.emacs.d/lisp/tide b/emacs/.emacs.d/lisp/tide new file mode 160000 +Subproject 28137ed904deb143dba8f8f67660966e11921c6 diff --git a/emacs/.emacs.d/lisp/tree-sitter-langs b/emacs/.emacs.d/lisp/tree-sitter-langs new file mode 160000 +Subproject 0dd5e56e2f5646aa51ed0fc9eb869a8f7090228 diff --git a/emacs/.emacs.d/tempel-templates b/emacs/.emacs.d/tempel-templates new file mode 100644 index 0000000..0613c00 --- /dev/null +++ b/emacs/.emacs.d/tempel-templates @@ -0,0 +1,214 @@ +emacs-lisp-mode + +(autoload ";;;###autoload") +(lambda "(lambda (" p ")" n> r> ")") +(defvar "(defvar " p "\n \"" p "\")") +(defvar-local "(defvar-local " p "\n \"" p "\")") +(const "(defconst " p "\n \"" p "\")") +(custom "(defcustom " p "\n \"" p "\"" n> ":type '" p ")") +(defface "(defface " p " '((t :inherit " p "))\n \"" p "\")") +(defgroup "(defgroup " p " nil\n \"" p "\"" n> ":group '" p n> ":prefix \"" p "-\")") +(defmacro "(defmacro " p " (" p ")\n \"" p "\"" n> r> ")") +(defalias "(defalias '" p " '" p ")") +(defun "(defun " p " (" p ")\n \"" p "\"" n> r> ")") +(defcustom "(defun " p " (" p ")\n \"" p "\"" n> "(interactive" p ")" n> r> ")") +(if-let "(if-let (" p ")" n> r> ")") +(when-let "(when-let (" p ")" n> r> ")") +(if-let* "(if-let* (" p ")" n> r> ")") +(when-let* "(when-let* (" p ")" n> r> ")") +(cond "(cond" n "(" q "))" >) +(pcase "(pcase " p n "(" q "))" >) +(let "(let (" p ")" n> r> ")") +(let* "(let* (" p ")" n> r> ")") +(dotimes "(dotimes (" p ")" n> r> ")") +(dolist "(dolist (" p ")" n> r> ")") + +(agpl + ";; Copyright (C) " (p (format-time-string "%Y" (current-time)) year) " Free Software Foundation. + +;; Author: " (p user-full-name) " <" (p user-mail-address) "> +;; Package-Requires: " (format "((emacs \"%d.%d\"))" + emacs-major-version + emacs-minor-version) " + +;; This file is part of " (p (file-name-nondirectory (directory-file-name (project-root (project-current)))) project) ". + +;; " (s project) " 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. + +;; " (s project) " 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 " (s project) ". If not, see <https://www.gnu.org/licenses/>. +") + +fundamental-mode ;; Available everywhere + +(today (format-time-string "%Y-%m-%d %a")) +(now (format-time-string "%Y-%m-%d %a %H:%M")) + +prog-mode + +(fixme (if (derived-mode-p 'emacs-lisp-mode) ";; " comment-start) "FIXME: ") +(todo (if (derived-mode-p 'emacs-lisp-mode) ";; " comment-start) "TODO: ") +(bug (if (derived-mode-p 'emacs-lisp-mode) ";; " comment-start) "BUG: ") +(hack (if (derived-mode-p 'emacs-lisp-mode) ";; " comment-start) "HACK: ") + +latex-mode + +(abstract "\\begin{abstract}\n" r> n> "\\end{abstract}") +(align "\\begin{align}\n" r> n> "\\end{align}") +(alignn "\\begin{align*}\n" r> n> "\\end{align*}") +(gather "\\begin{gather}\n" r> n> "\\end{gather}") +(gatherr "\\begin{gather*}\n" r> n> "\\end{gather*}") +(appendix "\\begin{appendix}\n" r> n> "\\end{appendix}") +(begin "\\begin{" (s env) "}" r> n> "\\end{" (s env) "}") +(center "\\begin{center}\n" r> n> "\\end{center}") +(displaymath "\\begin{displaymath}\n" r> n> "\\end{displaymath}") +(document "\\begin{document}\n" r> n> "\\end{document}") +(enumerate "\\begin{enumerate}\n\\item " r> n> "\\end{enumerate}") +(equation "\\begin{equation}" r> n> "\\end{equation}") +(flushleft "\\begin{flushleft}" r> n> "\\end{flushleft}") +(flushright "\\begin{flushright}" r> n> "\\end{flushright}") +(frac "\\frac{" p "}{" q "}") +(fussypar "\\begin{fussypar}" r> n> "\\end{fussypar}") +(itemize "\\begin{itemize}\n\\item " r> n> "\\end{itemize}") +(letter "\\begin{letter}\n" r> n> "\\end{letter}") +(math "\\begin{math}\n" r> n> "\\end{math}") +(minipage "\\begin{minipage}[t]{0.5\linewidth}\n" r> n> "\\end{minipage}") +(quotation "\\begin{quotation}\n" r> n> "\\end{quotation}") +(quote "\\begin{quote}\n" r> n> "\\end{quote}") +(sloppypar "\\begin{sloppypar}\n" r> n> "\\end{sloppypar}") +(theindex "\\begin{theindex}\n" r> n> "\\end{theindex}") +(trivlist "\\begin{trivlist}\n" r> n> "\\end{trivlist}") +(verbatim "\\begin{verbatim}\n" r> n> "\\end{verbatim}") +(verbatimm "\\begin{verbatim*}\n" r> n> "\\end{verbatim*}") + +texinfo-mode + +(defmac "@defmac " p n> r> "@end defmac") +(defun "@defun " p n> r> "@end defun") +(defvar "@defvar " p n> r> "@end defvar") +(example "@example " p n> r> "@end example") +(lisp "@lisp " p n> r> "@end lisp") +(bullet "@itemize @bullet{}" n> r> "@end itemize") +(code "@code{" p "}") +(var "@var{" p "}") + +lisp-mode emacs-lisp-mode ;; Specify multiple modes + +(lambda "(lambda (" p ")" n> r> ")") + +emacs-lisp-mode + +(autoload ";;;###autoload") +(pt "(point)") +(lambda "(lambda (" p ")" n> r> ")") +(var "(defvar " p "\n \"" p "\")") +(local "(defvar-local " p "\n \"" p "\")") +(const "(defconst " p "\n \"" p "\")") +(custom "(defcustom " p "\n \"" p "\"" n> ":type '" p ")") +(face "(defface " p " '((t :inherit " p "))\n \"" p "\")") +(group "(defgroup " p " nil\n \"" p "\"" n> ":group '" p n> ":prefix \"" p "-\")") +(macro "(defmacro " p " (" p ")\n \"" p "\"" n> r> ")") +(alias "(defalias '" p " '" p ")") +(fun "(defun " p " (" p ")\n \"" p "\"" n> r> ")") +(iflet "(if-let (" p ")" n> r> ")") +(whenlet "(when-let (" p ")" n> r> ")") +(whilelet "(while-let (" p ")" n> r> ")") +(andlet "(and-let* (" p ")" n> r> ")") +(cond "(cond" n "(" q "))" >) +(pcase "(pcase " (p "scrutinee") n "(" q "))" >) +(let "(let (" p ")" n> r> ")") +(lett "(let* (" p ")" n> r> ")") +(pcaselet "(pcase-let (" p ")" n> r> ")") +(pcaselett "(pcase-let* (" p ")" n> r> ")") +(rec "(letrec (" p ")" n> r> ")") +(dotimes "(dotimes (" p ")" n> r> ")") +(dolist "(dolist (" p ")" n> r> ")") +(loop "(cl-loop for " p " in " p " do" n> r> ")") +(command "(defun " p " (" p ")\n \"" p "\"" n> "(interactive" p ")" n> r> ")") +(advice "(defun " (p "adv" name) " (&rest app)" n> p n> "(apply app))" n> + "(advice-add #'" (p "fun") " " (p ":around") " #'" (s name) ")") + +(header ";;; " (file-name-nondirectory (or (buffer-file-name) (buffer-name))) + " -- " (p "short-desc" short-desc) " -*- lexical-binding: t -*-" n n + (i agpl) n + ";;; Commentary: + +;; " (s short-desc) "." p n n + ";;; Code:" n n) + +(lb ";; -*- lexical-binding: t; -*-" n n) + +(provide "(provide '" (file-name-base (or (buffer-file-name) (buffer-name))) ")" n + ";;; " (file-name-nondirectory (or (buffer-file-name) (buffer-name))) + " ends here" n) + +eshell-mode + +(for "for " (p "i") " in " p " { " q " }") +(while "while { " p " } { " q " }") +(until "until { " p " } { " q " }") +(if "if { " p " } { " q " }") +(ife "if { " p " } { " p " } { " q " }") +(unl "unless { " p " } { " q " }") +(unle "unless { " p " } { " p " } { " q " }") + +text-mode + +(box "┌─" (make-string (length str) ?─) "─┐" n + "│ " (s str) " │" n + "└─" (make-string (length str) ?─) "─┘" n) +(abox "+-" (make-string (length str) ?-) "-+" n + "| " (s str) " |" n + "+-" (make-string (length str) ?-) "-+" n) +(cut "--8<---------------cut here---------------start------------->8---" n r n + "--8<---------------cut here---------------end--------------->8---" n) +(rot13 (p "plain text" text) n "----" n (rot13 text)) +(calc (p "taylor(sin(x),x=0,3)" formula) n "----" n (format "%s" (calc-eval formula))) + +rst-mode + +(title (make-string (length title) ?=) n (p "Title: " title) n (make-string (length title) ?=) n) + +java-mode + +(class "public class " (p (file-name-base (or (buffer-file-name) (buffer-name)))) " {" n> r> n "}") + +c-mode :when (re-search-backward "^\\S-*$" (line-beginning-position) 'noerror) + +(inc "#include <" (p (concat (file-name-base (or (buffer-file-name) (buffer-name))) ".h")) ">") +(incc "#include \"" (p (concat (file-name-base (or (buffer-file-name) (buffer-name))) ".h")) "\"") + +org-mode + +(caption "#+caption: ") +(drawer ":" p ":" n r ":end:") +(begin "#+begin_" (s name) n> r> n "#+end_" name) +(quote "#+begin_quote" n> r> n "#+end_quote") +(sidenote "#+begin_sidenote" n> r> n "#+end_sidenote") +(marginnote "#+begin_marginnote" n> r> n "#+end_marginnote") +(example "#+begin_example" n> r> n "#+end_example") +(center "#+begin_center" n> r> n "#+end_center") +(ascii "#+begin_export ascii" n> r> n "#+end_export") +(html "#+begin_export html" n> r> n "#+end_export") +(latex "#+begin_export latex" n> r> n "#+end_export") +(comment "#+begin_comment" n> r> n "#+end_comment") +(verse "#+begin_verse" n> r> n "#+end_verse") +(src "#+begin_src " q n> r> n "#+end_src") +(gnuplot "#+begin_src gnuplot :var data=" (p "table") " :file " (p "plot.png") n> r> n "#+end_src" :post (org-edit-src-code)) +(elisp "#+begin_src emacs-lisp" n> r> n "#+end_src" :post (org-edit-src-code)) +(inlsrc "src_" p "{" q "}") +(title "#+title: " p n "#+author: " (user-full-name) n "#+language: en") + + +;; Local Variables: +;; mode: lisp-data +;; outline-regexp: "[a-z]" +;; End: |