mirror of
https://github.com/pestctrl/emacs-config.git
synced 2026-02-16 08:14:15 +00:00
26 KiB
26 KiB
- posting source code
- Notifications
- Ace jump
- Various tools
- pdf-tools use isearch
- transpose-frame
- e2wm
- Helpful view-mode
- pavucontrol switch speakers headphones
- rmsbolt
- ivy-posframe
- Elfeed
- shell-command+
- shackle-mode
- Emojis!
- dired-rsync
- keyfreq
- Hammy?
- Auto dim buffers
- Visualization tools
- Launch vterm
posting source code
(use-package webpaste)
(setq webpaste-paste-confirmation t)
(setq webpaste-provider-priority '("ix.io"))Notifications
(use-package ednc
:config
;; (defun stack-notifications (&optional hide)
;; (mapconcat (lambda (notification)
;; (let ((app-name (ednc-notification-app-name notification)))
;; (unless (member app-name hide)
;; (push app-name hide)
;; (ednc-format-notification notification))))
;; (ednc-notifications) ""))
;; (nconc global-mode-string '((:eval (list-notifications))))
;; (add-hook 'ednc-notification-presentation-functions
;; (lambda (&rest _) (force-mode-line-update t)))
(defun show-notification-in-buffer (old new)
(let ((name (format "Notification %d" (ednc-notification-id (or old new)))))
(with-current-buffer (get-buffer-create name)
(if (not new)
(kill-buffer)
(let ((inhibit-read-only t))
(if old (erase-buffer) (ednc-view-mode))
(insert (ednc-format-notification new t))
(my/display-buffer-in-side-window
'bottom
(current-buffer)
nil
'(window-height . 6)))))))
(add-hook 'ednc-notification-presentation-functions
#'show-notification-in-buffer)) (when (and
(ec/load-or-ask-pred 'my-ec/enable-mail "Enable mail? ")
my-ec/authinfo-exists)
(require 'emacs-mail))Ace jump
(use-package ace-jump-mode
:bind (("C-c j" . 'ace-jump-line-mode)
:map *root-map*
("SPC" . 'ace-jump-mode)))Various tools
ledger
(use-package ledger-mode
:mode "\\.dat\\'"
:config
(setq ledger-narrow-on-reconcile nil)
(setq ledger-reports
`(("account" "%(binary) -f %(ledger-file) reg %(account)")
("credit card" "%(binary) -f %(ledger-file) reg %(account) --aux-date --sort -d")
("bal" "%(binary) -f %(ledger-file) bal")
("reg" "%(binary) -f %(ledger-file) reg")
("equity" "%(binary) -f %(ledger-file) bal ^Exp ^RE ^Rev")
("uncleared" "%(binary) -f %(ledger-file) reg --uncleared --limit=\"payee!='Texas Instruments Income'\"")
("last-superfluous" "%(binary) -f %(ledger-file) bal --limit='account =~ /^Exp:(Food|Luxury|NewTech|People)/ && date >= [this month]'")
("superfluous" "%(binary) -f %(ledger-file) reg --limit='account =~ /^Exp:(Food|Luxury|NewTech|People)/'")
("recurring" "%(binary) -f %(ledger-file) reg --limit='has_tag(\"RECURRING\")' ^Exp")
("expmonth" "%(binary) -f %(ledger-file) -M reg Expenses")
("owedmom" "%(binary) -f %(ledger-file) reg Liabilities")
("progress" "%(binary) -f %(ledger-file) reg Assets Equity Liabilities")
("payee" "%(binary) -f %(ledger-file) reg @%(payee)")
("lia1" "%(binary) -f %(ledger-file) bal ^Lia --cleared")
("lia2" "%(binary) -f %(ledger-file) reg ^Lia --uncleared")
("Ast:AR" "%(binary) -f %(ledger-file) bal ^Ast:AR")
("earned-money" "%(binary) -f %(ledger-file) bal ^Rev:TI ^Exp:Necessary:Tax ^Exp:Necessary:Insurance ^Exp:Necessary:GroupLife")))
(setq dynamic-reports
'(("budgetcal" "%(binary) -f ~/MEGA/org/entries/food.ledger --daily --add-budget reg Expenses")))
(use-package stripes)
(add-hook 'ledger-report-after-report-hook
#'(lambda ()
(stripes-mode 2)))
(require 'parse-time)
(defun ledger-narrow-to-date-range ()
(interactive)
(goto-char (line-beginning-position))
(when (looking-at
(rx (and
(separated-list " - "
(group (= 2 digit)) "-" (group (= 3 alpha))
"-" (= 2 digit)))))
(let ((year (match-string 1))
(month-start (cdr (assoc (downcase (match-string 2)) parse-time-months))))
(setq ledger-report-cmd
(--> ledger-report-cmd
(string-replace " -M" "" it)
(string-replace " -n" "" it)
(string-replace " -A" "" it)
(concat it
" "
(format " -b 20%s-%d"
year
month-start)
(format " -e 20%s-%d" year (1+ month-start)))))
(ledger-report-redo))))
(define-key ledger-report-mode-map (kbd "n")
#'ledger-narrow-to-date-range)
(defun ledger-accounts-expand-includes (orig)
(let (includes)
(save-excursion
(goto-char (point-min))
(while (re-search-forward (rx line-start "include "
(group (+ nonl)))
nil t)
(push (match-string 1) includes)))
(append
(cl-mapcan #'(lambda (file)
(with-current-buffer (find-file-noselect
(expand-file-name file))
(ledger-accounts-in-buffer)))
includes)
(funcall orig))))
(advice-add #'ledger-accounts-in-buffer
:around
#'ledger-accounts-expand-includes)
(defun check-account-in-buffer (account)
(member (list account) (ledger-accounts-in-buffer)))
(advice-add #'ledger-reconcile-check-valid-account
:override
#'check-account-in-buffer)
;; TODO there has to be a better way to do this
(defun save-after-reconcile-toggle (&rest args)
(save-buffer))
;; (advice-add #'ledger-toggle-current
;; :after
;; #'save-after-reconcile-toggle)
(defun ledger-dynamic-report ()
(interactive)
(let* ((ledger-reports dynamic-reports)
(report-name (ledger-report-read-name)))
(ledger-report report-name nil)))
(setq ledger-reconcile-buffer-line-format
"%(date)s %-4(code)s %-30(payee)s %-30(account)s %15(amount)s\n")
(defun ledger-account-check-dont-include-regexp (orig account)
(when (= (aref account 0)
?^)
(setq account
(substring account 1))))
(defun ledger-report-show-monthly-average ()
(interactive)
(let ((average-string "-A -M -n"))
(unless (string-match-p average-string ledger-report-cmd)
(setq ledger-report-cmd
(--> ledger-report-cmd
(replace-regexp-in-string
(rx " -b " (+ (not " "))) "" it)
(replace-regexp-in-string
(rx " -e " (+ (not " "))) "" it)
(concat it " " average-string)))
(ledger-report-redo))))
(setq ledger-amount-regexp
(concat
"\\( \\|\t\\| \t\\)[ \t]*-?"
"\\(?:" "?-" ledger-commodity-regexp " *\\)?"
;; We either match just a number after the commodity with no
;; decimal or thousand separators or a number with thousand
;; separators. If we have a decimal part starting with `,'
;; or `.', because the match is non-greedy, it must leave at
;; least one of those symbols for the following capture
;; group, which then finishes the decimal part.
"\\(-?\\(?:[0-9]+\\|[0-9,.]+?\\)\\)"
"\\([,.][0-9)]+\\)?"
"\\(?: *" ledger-commodity-regexp "\\)?"
"\\([ \t]*[@={]@?[^\n;]+?\\)?"
"\\([ \t]+;.+?\\|[ \t]*\\)?$"))
(define-key ledger-report-mode-map (kbd "M") #'ledger-report-show-monthly-average)
(defun my/ledger-complete-xact--remove-stars ()
(interactive)
(let* ((date-regexp (rx (and line-start (= 4 digit) "/" (= 2 digit) "/" (= 2 digit))))
(start (save-excursion
(re-search-backward date-regexp)
(point)))
(end (save-excursion
(or (re-search-forward date-regexp nil t)
(end-of-buffer))
(beginning-of-line)
(point))))
(save-window-excursion
(save-restriction
(narrow-to-region start end)
(beginning-of-buffer)
(save-excursion
(replace-regexp (rx " "
(or "*" "!")
" "
(group (+ (not (any " " "\n")))))
" \\1 "))
(save-excursion
(replace-regexp (rx (and " " (+ " ")
";; [" (+ (any digit "-" "=" "/")) "]"
line-end))
""))
(save-excursion
(replace-regexp (rx line-start (group (+ (any "/" digit)) " ")
" ")
"\\1"))))))
(advice-add #'ledger-fully-complete-xact
:after
#'my/ledger-complete-xact--remove-stars)
(defun my/ledger-clean-commodity ()
(save-excursion
(beginning-of-buffer)
(replace-regexp (rx " -$") " $-")))
(advice-add #'ledger-mode-clean-buffer
:after
#'my/ledger-clean-commodity)
(defun my/ledger-convert-alias (account)
(save-excursion
(goto-char (point-min))
(let ((regexp
(rx line-start
"alias " (literal account) "="
(group (+ (or alphanumeric ":" "_")))
(* space)
line-end)))
(or (and (re-search-forward regexp nil t)
(aprog1 (match-string 1)
(set-text-properties 0 (length it) nil it)))
account))))
(advice-add #'ledger-read-account-with-prompt
:filter-return
#'my/ledger-convert-alias)
(defun my/ledger-field (orig context field)
(let ((res (funcall orig context field)))
(if (or (not (eq field 'account))
(null res)
(not (string-match (rx (group (separated-list ":" (separated-list " " (+ alphanumeric)))) " ") res)) )
res
(match-string 1 res))))
;; (advice-add #'ledger-context-field-value
;; :around
;; #'my/ledger-field)
(defun my/ledger-reconcile-switch-to-master (&rest args)
(interactive)
(switch-to-buffer (find-file-noselect ledger-master-file)))
;; (advice-add #'ledger-reconcile
;; :before
;; #'my/ledger-reconcile-switch-to-master)
)Credit Card Statement Macro
(fset 'credit_card_statement
[?\M-x ?o ?r ?g ?- ?m ?o ?d ?e return ?\M-x ?q backspace ?r ?e ?p ?l ?a ?c ?e ?- ?r ?e ?g ?e ?x ?p return ?^ ?\C-q tab return ? ? ? ? return ?\M-< ?\C- ?\C-f ?\C-f ?\C-f ?\C-f ?\C-c ?m ?a ?\C-w ?- ? ?\[ ? ?\] ? ?\C-e ?\C-k ?\C-c ?m ? ?\C-q tab ?\C-q tab ?\C-e ?\C-j ?y ?\C-a ?_ ?_ ?_ ?_ backspace backspace backspace backspace ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?= ?\C-p ?\C-p ?\C-k ?\C-c ?m ? ?\C-q tab ?\C-q tab ?\C-d ?\C-d return ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n ?\C-n])debbugs
(use-package debbugs)
(defun my/debbugs-gnu-select-report ()
"Select the report on the current line."
(interactive)
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
;; We open the report messages.
(let* ((status (debbugs-gnu-current-status))
(id (alist-get 'id status))
(merged (alist-get 'mergedwith status)))
(setq merged (if (listp merged) merged (list merged)))
(cond
((not id)
(message "No bug report on the current line"))
((eq debbugs-gnu-mail-backend 'rmail)
(debbugs-gnu-read-emacs-bug-with-rmail id status merged))
((eq debbugs-gnu-mail-backend 'gnus)
(debbugs-gnu-read-emacs-bug-with-gnus id status merged))
((eq debbugs-gnu-mail-backend 'notmuch)
(notmuch-tree (concat "tag:bug-gnu-emacs " (format "subject:\"bug#%s\"" id))))
(t (error "No valid mail backend specified")))))
(setq debbugs-gnu-mail-backend 'notmuch)
(advice-add #'debbugs-gnu-select-report
:override
#'my/debbugs-gnu-select-report)erc
(use-package erc)
(use-package erc-hl-nicks)
(use-package erc-colorize)
(require 'netrc)
(erc-hl-nicks)
(erc-colorize-mode)
(setq erc-user-full-name "Benson Chu"
erc-kill-buffer-on-part t
erc-track-exclude-types
'("JOIN" "QUIT" "PART" "NICK" "333" "353"))
(setq erc-autojoin-channels-alist
'(("freenode.net" "#emacs" "#org-mode"
;; "##linux" "#compilers" "#pltclub"
;; "##cs" "##computerscience" "##programming" "#lisp" "##lisp"
;; "#sbcl" "#ecl"
)
("libera.chat" "#emacs" "#org-mode" "#archlinux"
"#commonlisp" "#sbcl" "#compilers" "#nixos"
;; "##linux" "#pltclub"
;; "##cs" "##computerscience" "##programming" "#lisp" "##lisp"
;; "#ecl"
)))
(defun get-authinfo (host port &optional user)
(let* ((hostentry (car (auth-source-search :host host :port port :user user))))
(when hostentry (funcall (plist-get hostentry :secret)))))
(defun freenode-connect (nick password)
(erc :server "irc.freenode.net" :port 6667
:password password :nick nick))
(defun libera-connect (nick password)
(erc-tls :server "irc.libera.chat" :port 6697
:password password :nick nick))
(defun irc-connect ()
(interactive)
(when (y-or-n-p "Connect to IRC? ")
(libera-connect "pestctrl" (get-authinfo "irc.libera.chat" "6697" "pestctrl"))))font-lock-studio
(use-package font-lock-studio)
(when (>= emacs-major-version 29)
(define-obsolete-function-alias 'font-lock-fontify-syntactically-region #'font-lock-default-fontify-syntactically "29.1"))pdf-tools use isearch
(when (and (not (eq system-type 'windows-nt))
(not my-ec/at-ti))
(use-package pdf-tools)
(pdf-tools-install)
(define-key pdf-view-mode-map (kbd "C-s") 'isearch-forward)
(define-key pdf-view-mode-map (kbd "d") (lambda () (interactive) (pdf-view-next-line-or-next-page 8)))
(define-key pdf-view-mode-map (kbd "u") (lambda () (interactive) (pdf-view-previous-line-or-previous-page 8))))transpose-frame
(use-package transpose-frame)e2wm
(use-package e2wm
:bind (("M-+" . e2wm:start-management)))Helpful view-mode
(defun helpful--navigate-view-mode (orig button)
(let ((w (window-parameter (selected-window) 'quit-restore)))
(funcall orig button)
(view-mode)
(setq-local view-exit-action
`(lambda (&rest args)
(set-window-parameter (selected-window) 'quit-restore ',w)))))
(advice-add #'helpful--navigate
:around
#'helpful--navigate-view-mode)pavucontrol switch speakers headphones
(require 'cl)
(defvar laptop-sink-index 0)
(defvar hdmi-pcie-interface nil)
(defun setup-headphone-stuff ()
(interactive)
(let* ((result (shell-command-to-string "pactl list short sinks")))
(when (string-match "\\([0-9]\\).*analog-stereo" result)
(setq laptop-sink-index
(string-to-number
(match-string 1 result))))
(when (string-match "[0-9].*\\(pci-.*\\)\\.hdmi-stereo" result)
(setq hdmi-pcie-interface
(match-string 1 result))))
(when hdmi-pcie-interface
(let* ((result (shell-command-to-string "pacmd list-modules"))
(split (cdr (split-string result "index: "))))
(cl-loop for mod in split
while (not
(string-match (format "\\([0-9]+\\)\n.*\n.*name=\"%s\"" hdmi-pcie-interface)
mod))
finally
do (shell-command
(format "pactl unload-module %s"
(match-string 1 mod)))))))
(defun current-speakers ()
(let ((string (shell-command-to-string "pactl list sinks | grep 'Active Port: '")))
(if (string-match-p "headphones" string)
'headphones
'speakers)))
(defun toggle-audio-output ()
(interactive)
(if (eq (current-speakers)
'headphones)
(shell-command (format "pactl set-sink-port %d analog-output-speaker"
laptop-sink-index))
(shell-command (format "pactl set-sink-port %d analog-output-headphones"
laptop-sink-index)))
(message (format "Switched to: %s" (current-speakers))))
(exwm-global-set-key (kbd "s-s") #'toggle-audio-output)
;; (use-exwm
;; :config
;; (add-hook 'exwm-init-hook #'setup-headphone-stuff))rmsbolt
(use-package rmsbolt)ivy-posframe
(require 'cl)
(unless my-ec/at-ti
(use-package ivy-posframe
:config
(setq ivy-posframe-display-functions-alist
'((swiper . ivy-posframe-display-at-frame-center)
(complete-symbol . ivy-posframe-display-at-point)
(iwc-switch-to-wc . nil)
(t . ivy-posframe-display-at-window-top-center)))
(defun ivy-posframe-display-at-window-top-center (str)
(ivy-posframe--display str #'posframe-poshandler-window-top-center))
(defun posframe-poshandler-window-top-center (info)
"Posframe's position handler.
Get a position which let posframe stay onto current window's
center. The structure of INFO can be found in docstring
of `posframe-show'."
(let* ((frame-width (plist-get info :parent-frame-width))
(window-left (plist-get info :parent-window-left))
(window-top (plist-get info :parent-window-top))
(window-width (plist-get info :parent-window-width))
(posframe-width (plist-get info :posframe-width)))
(cons (min (- frame-width posframe-width)
(+ window-left (max 0
(/ (- window-width posframe-width) 2))))
(+ window-top 50))))
(defun disable-ivy-posframe-on-exwm-windows (orig &rest args)
(if (not (eq major-mode 'exwm-mode))
(apply orig args)
(cl-letf (((symbol-function 'display-graphic-p) (lambda (&optional display) nil)))
(apply orig args))))
(advice-add #'ivy-posframe--read
:around
#'disable-ivy-posframe-on-exwm-windows))
(unless (eq 'hash-table (type-of face-new-frame-defaults))
;; (def-face-copier my/posframe-faces (sym)
;; (let ((name (symbol-name sym)))
;; (string-match-p "^ivy-.*"
;; name)))
;;(setq ivy-posframe-min-height 0)
;; (setq ivy-posframe-height 24)
;; (setq ivy-height-alist
;; '((t . 24)))
;; (setq ivy-posframe-height-alist
;; '((counsel-M-x . 8)
;; (t . 24)))
;; '((swiper . 24)))
))Elfeed
(require 'elfeed)
(setq elfeed-use-curl t)
(elfeed-set-timeout 36000)
(setq elfeed-curl-extra-arguments '("--insecure"))
;; enable elfeed-protocol
(elfeed-protocol-enable)shell-command+
(use-package shell-command+
:bind ("M-!" . shell-command+))shackle-mode
(use-package shackle)
(defun shackle--display-buffer-reuse (buffer alist)
(let ((window (display-buffer-reuse-window buffer
;; Reuse frames
(cons '(reusable-frames . t) alist))))
(prog1 window
(when (and window (window-live-p window)
shackle-select-reused-windows)
(select-window window)))))
(setq switch-to-buffer-obey-display-actions t
shackle-select-reused-windows t)
(setq shackle-rules '(("the_plan" :select t)))
(shackle-mode 1)
(defun get-the-plan ()
(with-current-buffer (find-file-noselect (my/agenda-file "plan.org"))
(rename-buffer "the_plan")
(current-buffer)))
(defun the-plan ()
(interactive)
(switch-to-buffer (get-the-plan)))
(exwm-global-set-key (kbd "s-p") #'the-plan)Emojis!
(use-package emojify)dired-rsync
(use-package dired-rsync
:config
(bind-key "C-c C-r" 'dired-rsync dired-mode-map)
(add-to-list 'global-mode-string 'dired-rsync-modeline-status t))keyfreq
(use-package keyfreq
:init
(setq keyfreq-excluded-commands
'(self-insert-command
org-self-insert-command
exwm-input-send-simulation-key
tab-bar-mouse-1
abort-recursive-edit
forward-char
backward-char
previous-line
next-line))
(keyfreq-mode 1)
(keyfreq-autosave-mode 1))Hammy?
(use-package hammy
:quelpa (hammy :fetcher github :repo "alphapapa/hammy.el"))
(hammy-define "Move"
:documentation "Don't forget to stretch your legs."
:intervals
;; A list of intervals, each defined with the `interval' function.
(list (interval
;; The name of the interval is a string, used when selecting
;; hammys and shown in the mode line.
:name "💺"
;; The duration of the interval: a number of seconds, a string
;; passed to `timer-duration', or a function which returns such.
:duration "10 seconds"
;; Optionally, a face in which to show the
;; interval's name in the mode line.
:face 'font-lock-type-face
;; A list of actions to take before starting the interval
;; (really, one or a list of functions to call with the hammy
;; as the argument). The `do' macro expands to a lambda,
;; which the interval's `before' slot is set to. In its
;; body, we call two built-in helper functions.
:before (do (announce "Whew!")
(notify "Whew!"))
;; We want this interval to not automatically advance to the
;; next one; rather, we want the user to call the
;; `hammy-next' command to indicate when the standing-up is
;; actually happening. So we provide a list of actions to
;; take when it's time to advance to the next interval. We
;; wrap the list in a call to the built-in `remind' function,
;; which causes the actions to be repeated every 10 minutes
;; until the user manually advances to the next interval.
:advance (remind "2 seconds"
;; Every 10 minutes, while the hammy is waiting
;; to be advanced to the next interval, remind
;; the user by doing these things:
(do (announce "Time to stretch your legs!")
(notify "Time to stretch your legs!")
(play-sound-file "~/Misc/Sounds/mooove-it.wav"))))
(interval :name "🤸"
:duration "2 seconds"
:face 'font-lock-builtin-face
:before (do (announce "Mooove it!")
(notify "Mooove it!"))
;; Again, the interval should not advance automatically
;; to the next--the user should indicate when he's
;; actually sat down again. (If we omitted the
;; `:advance' slot, the interval would automatically
;; advance when it reached its duration.)
:advance (do (announce "Time for a sit-down...")
(notify "Time for a sit-down...")
(play-sound-file "~/Misc/Sounds/relax.wav")))))Auto dim buffers
(use-package auto-dim-other-buffers)
(set-face-attribute 'auto-dim-other-buffers-face nil :background "#700CB3")Visualization tools
(use-package graphviz-dot-mode)
;; TODO: There seems to be an issue with my face setup and svg
;; rendering.
(use-package pair-tree)Launch vterm
(require 'vterm)
(require 'dired)
(defun vterm--my-new ()
(save-window-excursion
(vterm t)))
(defun dired-open-with-vterm (command &optional arg file-list)
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg nil nil t)))
(list
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
files)))
(let ((buffer (vterm--my-new))
(buffer-name (format "<vterm-%s>"
(string-replace " " "-" command)))
(command (dired-shell-stuff-it command file-list t arg)))
(when-let ((existing (get-buffer buffer-name)))
(kill-buffer existing))
(switch-to-buffer buffer)
(sit-for 0.1)
(rename-buffer buffer-name)
(vterm-insert command)
(vterm-send-return)))
(define-key dired-mode-map (kbd "V") #'dired-open-with-vterm)