;;; init.el
(defvar user-home-directory
(concat (expand-file-name "~") "/"))
;; Keep emacs Custom-settings in separate file
(let ((file-name (expand-file-name "custom.el" user-emacs-directory)))
(when (not (file-exists-p file-name))
(write-region "" nil file-name)))
(setq custom-file
(expand-file-name
"custom.el"
user-emacs-directory))
(load custom-file)
;; Set up a settings dir
(defun create-directory-if-nonexistent (dir-name)
"Create a new directory if it does not exist"
(when (not (file-directory-p dir-name))
(make-directory dir-name)))
(create-directory-if-nonexistent
(expand-file-name "settings" user-emacs-directory))
(setq settings-dir
(expand-file-name
"settings"
user-emacs-directory))
(add-to-list 'load-path settings-dir)
;; Set path to dependencies
(create-directory-if-nonexistent
(expand-file-name "site-lisp" user-emacs-directory))
(setq site-lisp-dir
(expand-file-name
"site-lisp"
user-emacs-directory))
(add-to-list
'load-path site-lisp-dir)
;; Write backup files to own directory
(create-directory-if-nonexistent
(expand-file-name
(concat user-emacs-directory "backups")))
(setq backup-directory-alist
`(("." . ,(expand-file-name
(concat user-emacs-directory "backups")))))
(setenv "PATH" (concat (getenv "PATH") ":/home/munyoki/.guix-home/profile/bin/"))
(setq exec-path (append exec-path '("/home/munyoki/.guix-home/profile/bin/")))
(require 'setup-package)
(create-directory-if-nonexistent
(expand-file-name "defuns" user-emacs-directory))
(setq defuns-dir
(expand-file-name
"defuns"
user-emacs-directory))
(dolist (file (directory-files defuns-dir t "\\w+"))
(when (file-regular-p file)
(load file)))
(require 'server)
(unless (server-running-p)
(server-start))
(require 'appearance)
(require 'sane-defaults)
(require 'setup-elfeed)
(require 'setup-exwm)
(require 'org-time-budgets)
(require 'setup-org)
(require 'mailscripts)
;; Some consult goodies
(require 'consult)
;; Source for file in current directory
(defvar +consult-source-neighbor-file
`(:name "File in current directory"
:narrow ?.
:category file
:face consult-file
:history file-name-history
:state ,#'consult--file-state
:new ,#'consult--file-action
:items
,(lambda ()
(let ((ht (consult--buffer-file-hash)) items)
(dolist (file (completion-pcm--filename-try-filter
(directory-files "." 'full "\\`[^.]" nil 100))
(nreverse items))
(unless (or (gethash file ht) (not (file-regular-p file)))
(push (file-name-nondirectory file) items))))))
"Neighboring file source for `consult-buffer'.")
(unless (memq '+consult-source-neighbor-file consult-buffer-sources)
(let ((p (member 'consult--source-buffer consult-buffer-sources)))
(setcdr p (cons '+consult-source-neighbor-file (cdr p)))))
(defun consult--point-register-p (reg)
"Return non-nil if REG is a point register."
(markerp (cdr reg)))
(defvar consult-source-point-register
`(:name "Point Register"
:narrow ?r
:category consult-location
:state ,#'consult--jump-state
:enabled
,(lambda () (seq-some #'consult--point-register-p register-alist))
:items
,(lambda () (consult-register--candidates #'consult--point-register-p)))
"Point register source.")
(add-to-list 'consult-buffer-sources 'consult-source-point-register 'append)
(defvar +consult-exwm-filter "\\`\\*EXWM")
(defvar +consult-source-exwm
`(:name "EXWM"
:narrow ?x
;; :hidden t
:category buffer
:face consult-buffer
:history buffer-name-history
;; Specify either :action or :state
:action ,#'consult--buffer-action ;; No preview
;; :state ,#'consult--buffer-state ;; Preview
:items
,(lambda () (consult--buffer-query
:sort 'visibility
:as #'buffer-name
:exclude (remq +consult-exwm-filter consult-buffer-filter)
:mode 'exwm-mode)))
"EXWM buffer source.")
(with-eval-after-load "ispell"
(setq ispell-program-name "hunspell")
;; (setq ispell-dictionary "en_GB,en_US-med")
;; ispell-set-spellchecker-params has to be called
;; before ispell-hunspell-add-multi-dic will work
;; (ispell-set-spellchecker-params)
;; (ispell-hunspell-add-multi-dic "en_GB,en_US-med")
)
(add-to-list 'consult-buffer-filter +consult-exwm-filter)
(add-to-list 'consult-buffer-sources '+consult-source-exwm 'append)
;;; init.el ends here
Really quick way to insert evaluated functions in the buffer.
;;; lisp-defuns.el -*- lexical-binding: t; -*-
;; A very simple function to recreate the scratch buffer:
;; ( http://emacswiki.org/emacs/RecreateScratchBuffer )
(defun munyoki/set-50-char ()
(set-fill-column 50)
(visual-line-mode)
(visual-fill-column-mode))
(defun eval-and-replace ()
"Replace the preceding sexp with its value."
(interactive)
(backward-kill-sexp)
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
(error (message "Invalid expression")
(insert (current-kill 0)))))
(defun keyboard-quit-strong ()
"Run `keyboard-quit' to return emacs to a more responsive state.
If repeated twice in a row, run `top-level' instead, to also exit
any recursive editing levels."
(interactive)
(when (eq last-command 'keyboard-quit-strong)
(setq this-command 'top-level) ;dis-arm a 3rd C-g
(ding)
(top-level))
;; Not reached after `top-level'. (A rare behavior in lisp.)
(keyboard-quit))
(defun scratch ()
"create a scratch buffer"
(interactive)
(switch-to-buffer-other-window (get-buffer-create "*scratch*"))
(insert initial-scratch-message)
(org-mode))
;;; It is the opposite of fill-paragraph
(defun unfill-paragraph ()
"Takes a multi-line paragraph and makes it into a single line of text."
(interactive)
(let ((fill-column (point-max)))
(fill-paragraph nil)))
(defun toggle-window-split ()
(interactive)
(if (= (count-windows) 2)
(let* ((this-win-buffer (window-buffer))
(next-win-buffer (window-buffer (next-window)))
(this-win-edges (window-edges (selected-window)))
(next-win-edges (window-edges (next-window)))
(this-win-2nd (not (and (<= (car this-win-edges)
(car next-win-edges))
(<= (cadr this-win-edges)
(cadr next-win-edges)))))
(splitter
(if (= (car this-win-edges)
(car (window-edges (next-window))))
'split-window-horizontally
'split-window-vertically)))
(delete-other-windows)
(let ((first-win (selected-window)))
(funcall splitter)
(if this-win-2nd (other-window 1))
(set-window-buffer (selected-window) this-win-buffer)
(set-window-buffer (next-window) next-win-buffer)
(select-window first-win)
(if this-win-2nd (other-window 1))))))
(defun untabify-buffer ()
(interactive)
(untabify (point-min) (point-max)))
(defun cleanup-buffer ()
"Perform a bunch of operations on the whitespace content of a buffer.
Including indent-buffer, which should not be called automatically on save."
(interactive)
(untabify-buffer)
(delete-trailing-whitespace)
(indent-buffer))
(defun copy-file-path (&optional @dir-path-only-p)
"Copy the current buffer's file path or dired path to `kill-ring'.
Result is full path. If `universal-argument' is called first,
copy only the dir path. If in dired, copy the file/dir cursor is
on, or marked files. If a buffer is not file and not dired, copy
value of `default-directory' (which is usually the “current” dir
when that buffer was created) URL
`http://ergoemacs.org/emacs/emacs_copy_file_path.html' Version
2017-09-01"
(interactive "P")
(let (($fpath
(if (string-equal major-mode 'dired-mode)
(progn
(let (($result (mapconcat 'identity (dired-get-marked-files) "\n")))
(if (equal (length $result) 0)
(progn default-directory )
(progn $result))))
(if (buffer-file-name)
(buffer-file-name)
(expand-file-name default-directory)))))
(kill-new
(if @dir-path-only-p
(progn
(message "Directory path copied: 「%s」" (file-name-directory $fpath))
(file-name-directory $fpath))
(progn
(message "File path copied: 「%s」" $fpath)
$fpath )))))
(defun insert-file-name (filename &optional args)
"Insert name of file FILENAME into buffer after point.
Prefixed with \\[universal-argument], expand the file name to
its fully canocalized path. See `expand-file-name'.
Prefixed with \\[negative-argument], use relative path to file
name from current directory, `default-directory'. See
`file-relative-name'.
The default with no prefix is to insert the file name exactly as
it appears in the minibuffer prompt."
;; Based on insert-file in Emacs -- ashawley 20080926
(interactive "*fInsert file name: \nP")
(cond ((eq '- args)
(insert (file-relative-name filename)))
((not (null args))
(insert (expand-file-name filename)))
(t
(insert filename))))
;; http://iqbalansari.github.io/blog/2014/12/07/automatically-create-parent-directories-on-visiting-a-new-file-in-emacs/
(defun munyoki/create-non-existent-directory ()
"Offer to create parent directories if they do not exist"
(let ((parent-directory (file-name-directory buffer-file-name)))
(when (and (not (file-exists-p parent-directory))
(y-or-n-p (format "Directory `%s' does not exist! Create it?" parent-directory)))
(make-directory parent-directory t))))
(add-to-list 'find-file-not-found-functions 'munyoki/create-non-existent-directory)
;;; lisp-defuns.el ends hereConfigure the packages.
;;; setup-package.el
(require 'package)
;; Internet repos for new packages
(setq package-archives '(("nongnu" . "https://elpa.nongnu.org/nongnu/")
("elpa" . "http://elpa.gnu.org/packages/")
("melpa" . "https://melpa.org/packages/")))
;; Initialise the packages, avoiding a re-initialisation.
;; Make sure `use-package' is available.
(unless (package-installed-p 'use-package)
(package-refresh-contents)
(package-install 'use-package))
;; Configure `use-package' prior to loading it.
(eval-and-compile
(setq use-package-compute-statistics t)
;; The following is VERY IMPORTANT. Write hooks using their real name
;; instead of a shorter version: after-init ==> `after-init-hook'.
;;
;; This is to empower help commands with their contextual awareness,
;; such as `describe-symbol'.
(setq use-package-expand-minimally t)
(setq use-package-hook-name-suffix nil))
(setq package--initialized t)
(package-activate-all)
;; Setting up straight
(setq straight-disable-native-compilation t)
(defvar bootstrap-version)
(let ((bootstrap-file
(expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory))
(bootstrap-version 5))
(unless (file-exists-p bootstrap-file)
(with-current-buffer
(url-retrieve-synchronously
"https://raw.githubusercontent.com/raxod502/straight.el/develop/install.el"
'silent 'inhibit-cookies)
(goto-char (point-max))
(eval-print-last-sexp)))
(load bootstrap-file nil 'nomessage))
;; Do not resize the frame at this early stage.
(setq frame-inhibit-implied-resize t)
;; add $PATH to eshell
(use-package exec-path-from-shell
:ensure t
:init
(when (memq window-system '(mac ns x))
(exec-path-from-shell-initialize))
(when (daemonp)
(exec-path-from-shell-initialize)))
(use-package use-package-chords
:ensure t
:config (key-chord-mode 1))
(use-package use-package-ensure-system-package
:ensure t)
(use-package esup
:ensure t
;; To use MELPA Stable use ":pin melpa-stable",
:pin melpa
:init
(setq esup-depth 0))
(provide 'setup-package)
;;; setup-package.el“Sane” defaults go here. Also ad-hoc packages that don’t warrant their own section go here.
;;; sane-defaults.el
;; https://github.com/lukhas/buffer-move
;; autocomplete
(put 'flycheck-python-pylint-executable 'safe-local-variable #'stringp)
(setq rg-executable (executable-find "rg"))
(setq ripgrep-executable (executable-find "rg"))
(use-package eat
:ensure t
:hook
(eat-mode-hook . (lambda ()
(display-line-numbers-mode -1))))
;; purescript
(require 'psc-ide)
(add-hook 'purescript-mode-hook
(lambda ()
(turn-on-purescript-indentation)
(psc-ide-mode)
(company-mode)
(flycheck-mode)))
;; (use-package psc-ide
;; :ensure t
;; :mode ("\\.purs\\'")
;; :config
;; (require 'psc-ide)
;; :hook ((purescript-mode-hook . (lambda ()
;; (psc-ide-mode)
;; (company-mode)
;; (flycheck-mode)
;; (turn-on-purescript-indentation)))))
(use-package ement :ensure t)
(use-package super-save
:ensure t
:defer 1
:diminish super-save-mode
:config
(super-save-mode +1)
(setq super-save-auto-save-when-idle t))
(use-package desktop-environment :ensure t)
(use-package daemons :ensure t :commands daemons)
(use-package pulseaudio-control
:ensure t
:commands pulseaudio-control-select-sink-by-name
:config
(setq pulseaudio-control-pactl-path "/run/current-system/profile/bin/pactl"))
(defun munyoki/bluetooth-connect-qc35 ()
(interactive)
(start-process-shell-command "bluetoothctl" nil "bluetoothctl -- connect 4C:87:5D:CC:49:2E"))
(defun munyoki/bluetooth-disconnect ()
(interactive)
(start-process-shell-command "bluetoothctl" nil "bluetoothctl -- disconnect"))
(defun munyoki/ement-connect-secure ()
(interactive)
(ement-connect :uri-prefix "http://localhost:8009"))
;; Open files and goto lines like we see from g++ etc. i.e. file:line#
;; (to-do "make `find-file-line-number' work for emacsclient as well")
;; (to-do "make `find-file-line-number' check if the file exists")
(defadvice find-file (around find-file-line-number
(filename &optional wildcards)
activate)
"Turn files like file.cpp:14 into file.cpp and going to the 14-th line."
(save-match-data
(let* ((matched (string-match "^\\(.*\\):\\([0-9]+\\):?$" filename))
(line-number (and matched
(match-string 2 filename)
(string-to-number (match-string 2 filename))))
(filename (if matched (match-string 1 filename) filename)))
ad-do-it
(when line-number
;; goto-line is for interactive use
(goto-char (point-min))
(forward-line (1- line-number))))))
(defun munyoki/delete-file-and-buffer ()
"Kill the current buffer and deletes the file it is visiting."
(interactive)
(let ((filename (buffer-file-name)))
(when filename
(if (vc-backend filename)
(vc-delete-file filename)
(progn
(delete-file filename)
(message "Deleted file %s" filename)
(kill-buffer))))))
(global-set-key (kbd "C-c D") #'munyoki/delete-file-and-buffer)
(use-package page-break-lines :ensure t
:config
(global-page-break-lines-mode))
(defun geiser-racket--language ()
'())
(use-package geiser-guile
:ensure t
:config
(require 'geiser-guile))
(use-package geiser
:ensure t
:config
(setq geiser-default-implementation 'guile)
(setq geiser-active-implementations '(guile)))
(use-package pomm
:ensure t
:commands (pomm)
:custom
(alert-default-style 'libnotify)
:config
(pomm-mode-line-mode))
(use-package 0x0
:ensure t)
(use-package ace-window
:ensure t
:delight
:custom
(aw-dispatch-always nil)
(aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
:custom-face
(aw-leading-char-face
((t (:inherit ace-jump-face-foreground :height 2.0))))
:config
(ace-window-display-mode 1)
(add-to-list
'aw-dispatch-alist
'(?x
(lambda (window)
(aw-switch-to-window window)
(unwind-protect
(call-interactively 'execute-extended-command)
(aw-flip-window)))
"Execute Extended command"))
:chords ((",." . ace-window))
:bind (("C-x n o" . ace-window)))
(use-package auto-complete
:ensure t
:delight
:custom
(auto-complete-mode)
(ac-show-menu-immediately-on-auto-complete t)
:config
(ac-config-default))
(use-package avy
:ensure t
:delight
:init
(defun dictionary-search-dwim (&optional arg)
"Search for definition of word at point. If region is active,
search for contents of region instead. If called with a prefix
argument, query for word to search."
(interactive "P")
(if arg
(dictionary-search nil)
(if (use-region-p)
(dictionary-search (buffer-substring-no-properties
(region-beginning)
(region-end)))
(if (thing-at-point 'word)
(dictionary-lookup-definition)
(dictionary-search-dwim '(4))))))
(defun avy-action-helpful (pt)
(save-excursion
(goto-char pt)
(helpful-at-point))
(select-window
(cdr (ring-ref avy-ring 0)))
t)
(defun avy-show-dispatch-help ()
(let* ((len (length "avy-action-"))
(fw (frame-width))
(raw-strings (mapcar
(lambda (x)
(format "%2s: %-19s"
(propertize
(char-to-string (car x))
'face 'aw-key-face)
(substring (symbol-name (cdr x)) len)))
avy-dispatch-alist))
(max-len (1+ (apply #'max (mapcar #'length raw-strings))))
(strings-len (length raw-strings))
(per-row (floor fw max-len))
display-strings)
(cl-loop for string in raw-strings
for N from 1 to strings-len do
(push (concat string " ") display-strings)
(when (= (mod N per-row) 0) (push "\n" display-strings)))
(message "%s" (apply #'concat (nreverse display-strings)))))
;; Kill text
(defun avy-action-kill-whole-line (pt)
(save-excursion
(goto-char pt)
(kill-whole-line))
(select-window
(cdr
(ring-ref avy-ring 0)))
t)
(defun avy-action-copy-whole-line (pt)
(save-excursion
(goto-char pt)
(cl-destructuring-bind (start . end)
(bounds-of-thing-at-point 'line)
(copy-region-as-kill start end)))
(select-window
(cdr
(ring-ref avy-ring 0)))
t)
(defun avy-action-yank-whole-line (pt)
(avy-action-copy-whole-line pt)
(save-excursion (yank))
t)
(defun avy-action-teleport-whole-line (pt)
(avy-action-kill-whole-line pt)
(save-excursion (yank)) t)
;; Mark text
(defun avy-action-mark-to-char (pt)
(activate-mark)
(goto-char pt))
(defun avy-action-define (pt)
(save-excursion
(goto-char pt)
(dictionary-search-dwim))
(select-window
(cdr (ring-ref avy-ring 0)))
t)
(defun avy-action-embark (pt)
(unwind-protect
(save-excursion
(goto-char pt)
(embark-act))
(select-window
(cdr (ring-ref avy-ring 0))))
t)
:commands (avy-goto-word-1 avy-goto-char-2 avy-goto-char-timer)
:custom
(avy-keys '(?q ?e ?r ?u ?o ?p
?a ?s ?d ?f ?g ?h ?j
?l ?' ?c ?v ?b
?n ?, ?/))
(avy-timeout-seconds 0.05)
:config
(setf (alist-get ?k avy-dispatch-alist) 'avy-action-kill-stay
(alist-get ?K avy-dispatch-alist) 'avy-action-kill-whole-line
(alist-get ?w avy-dispatch-alist) 'avy-action-copy
(alist-get ?W avy-dispatch-alist) 'avy-action-copy-whole-line
(alist-get ?y avy-dispatch-alist) 'avy-action-yank
(alist-get ?Y avy-dispatch-alist) 'avy-action-yank-whole-line
(alist-get ?t avy-dispatch-alist) 'avy-action-teleport
(alist-get ?T avy-dispatch-alist) 'avy-action-teleport-whole-line
(alist-get ? avy-dispatch-alist) 'avy-action-mark-to-char
(alist-get ?= avy-dispatch-alist) 'dictionary-search-dwim
(alist-get ?H avy-dispatch-alist) 'avy-action-helpful
(alist-get ?. avy-dispatch-alist) 'avy-action-embark)
(setq avy-all-windows 'all-frames)
:bind (("C-x ," . avy-goto-char-timer)
:map isearch-mode-map
("M-j" . avy-isearch)))
(use-package buffer-move
:ensure t)
(use-package cl-lib
:ensure t)
(use-package consult
;; Replace bindings. Lazily loaded due by `use-package'.
:bind (;; C-c bindings in `mode-specific-map'
("C-c M-x" . consult-mode-command)
("C-c k" . consult-kmacro)
("C-c m" . consult-man)
("C-c i" . consult-info)
([remap Info-search] . consult-info)
;; C-x bindings in `ctl-x-map'
("C-x M-:" . consult-complex-command) ;; orig. repeat-complex-command
("C-x b" . consult-buffer) ;; orig. switch-to-buffer
("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window
("C-x 5 b" . consult-buffer-other-frame) ;; orig. switch-to-buffer-other-frame
("C-x r b" . consult-bookmark) ;; orig. bookmark-jump
("C-x p b" . consult-project-buffer) ;; orig. project-switch-to-buffer
;; Custom M-# bindings for fast register access
("M-#" . consult-register-load)
("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated)
("C-M-#" . consult-register)
;; Other custom bindings
("M-y" . consult-yank-pop) ;; orig. yank-pop
;; M-g bindings in `goto-map'
("M-g e" . consult-compile-error)
("M-g f" . consult-flymake) ;; Alternative: consult-flycheck
("M-g g" . consult-goto-line) ;; orig. goto-line
("M-g M-g" . consult-goto-line) ;; orig. goto-line
("M-g o" . consult-outline) ;; Alternative: consult-org-heading
("M-g m" . consult-mark)
("M-g k" . consult-global-mark)
("M-g i" . consult-imenu)
("M-g I" . consult-imenu-multi)
;; M-s bindings in `search-map'
("M-s d" . consult-find)
("M-s D" . consult-locate)
("M-s g" . consult-grep)
("M-s G" . consult-git-grep)
("M-s r" . consult-ripgrep)
("M-s l" . consult-line)
("M-s L" . consult-line-multi)
("M-s k" . consult-keep-lines)
("M-s u" . consult-focus-lines)
;; Isearch integration
("M-s e" . consult-isearch-history)
:map isearch-mode-map
("M-e" . consult-isearch-history) ;; orig. isearch-edit-string
("M-s e" . consult-isearch-history) ;; orig. isearch-edit-string
("M-s l" . consult-line) ;; needed by consult-line to detect isearch
("M-s L" . consult-line-multi) ;; needed by consult-line to detect isearch
;; Minibuffer history
:map minibuffer-local-map
("M-s" . consult-history) ;; orig. next-matching-history-element
("M-r" . consult-history)) ;; orig. previous-matching-history-element
;; Enable automatic preview at point in the *Completions* buffer. This is
;; relevant when you use the default completion UI.
:hook (completion-list-mode . consult-preview-at-point-mode)
;; The :init configuration is always executed (Not lazy)
:init
;; Optionally configure the register formatting. This improves the register
;; preview for `consult-register', `consult-register-load',
;; `consult-register-store' and the Emacs built-ins.
(setq register-preview-delay 0.5
register-preview-function #'consult-register-format)
;; Optionally tweak the register preview window.
;; This adds thin lines, sorting and hides the mode line of the window.
(advice-add #'register-preview :override #'consult-register-window)
;; Use Consult to select xref locations with preview
(setq xref-show-xrefs-function #'consult-xref
xref-show-definitions-function #'consult-xref)
;; Configure other variables and modes in the :config section,
;; after lazily loading the package.
:config
;; Optionally configure preview. The default value
;; is 'any, such that any key triggers the preview.
;; (setq consult-preview-key 'any)
;; (setq consult-preview-key "M-.")
(setq consult-preview-key '("S-<down>" "S-<up>"))
;; For some commands and buffer sources it is useful to configure the
;; :preview-key on a per-command basis using the `consult-customize' macro.
(consult-customize
consult-theme :preview-key '(:debounce 0.5)
consult-ripgrep consult-git-grep consult-grep
consult-bookmark consult-recent-file consult-xref
consult--source-bookmark consult--source-file-register
consult--source-recent-file consult--source-project-recent-file
;; :preview-key "M-."
:preview-key '(:debounce 0.5))
;; Optionally configure the narrowing key.
;; Both < and C-+ work reasonably well.
(setq consult-narrow-key "<"))
;;; Some consult goodies
;; Source for file in current directory
;; TODO
;;; end
(use-package consult-dir
:ensure t
:bind (("C-x C-d" . consult-dir)
:map vertico-map
("C-x C-d" . consult-dir)
("C-x C-j" . consult-dir-jump-file)))
(use-package debbugs
:ensure t
:custom
(debbugs-gnu-default-packages '("guix-patches" "guix")))
(use-package dictionary
:ensure t)
(use-package ag
:ensure t)
(use-package diminish
:ensure t
:after use-package
:config
(diminish 'eldoc-mode)
(diminish 'org-indent-mode)
(diminish 'subword-mode)
(diminish 'visual-line-mode "")
(diminish 'isearch-mode "?"))
(use-package diff-hl
:ensure t
:config
(global-diff-hl-mode))
(use-package dired-dragon
:straight (:host github
:repo "jeetelongname/dired-dragon")
:after dired
;; if you use use-package for bindings
:bind (:map dired-mode-map
("C-d d" . dired-dragon)
("C-d s" . dired-dragon-stay)
("C-d i" . dired-dragon-individual)))
(use-package dired-filter
:ensure t)
(use-package dmenu
:ensure t
:bind
(("C-c d" . dmenu)))
(use-package elpher
:ensure t)
(use-package elpy
:ensure t
:init
(elpy-enable))
(when (load "flycheck" t t)
(setq elpy-modules (delq 'elpy-module-flymake elpy-modules))
(add-hook 'elpy-mode-hook 'flycheck-mode))
(defun munyoki/insert-string ()
(interactive)
(save-excursion
;; (message "inserting string")
(insert (read-from-minibuffer "string: "))))
(global-set-key (kbd "C-c I") #'munyoki/insert-string)
(use-package embark
:ensure t
:init
(defun embark-magit-status (file)
"Run `magit-status` on repo containing the embark target."
(interactive "GFile: ")
(magit-status (locate-dominating-file file ".git")))
(eval-when-compile
(defmacro my/embark-ace-action (fn)
`(defun ,(intern (concat "my/embark-ace-" (symbol-name fn))) ()
(interactive)
(with-demoted-errors "%s"
(require 'ace-window)
(let ((aw-dispatch-always t))
(aw-switch-to-window (aw-select nil))
(call-interactively (symbol-function ',fn))))
)))
(eval-when-compile
(defmacro my/embark-split-action (fn split-type)
`(defun ,(intern (concat "my/embark-"
(symbol-name fn)
"-"
(car (last (split-string
(symbol-name split-type) "-"))))) ()
(interactive)
(funcall #',split-type)
(call-interactively #',fn))))
(defun sudo-find-file (file)
"Open FILE as root."
(interactive "FOpen file as root: ")
(when (file-writable-p file)
(user-error "File is user writeable, aborting sudo"))
(find-file (if (file-remote-p file)
(concat "/" (file-remote-p file 'method) ":"
(file-remote-p file 'user) "@" (file-remote-p file 'host)
"|sudo:root@"
(file-remote-p file 'host) ":" (file-remote-p file 'localname))
(concat "/sudo:root@localhost:" file))))
:bind
(;; pick some comfortable binding
("C-;" . embark-dwim) ;; good alternative: M-.
("C-." . embark-act)
("C-c b" . embark-become)
;; alternative for `describe-bindings'
("C-h B" . embark-bindings)
:map minibuffer-local-completion-map
("C-." . embark-act)
("C->" . embark-become)
:map embark-region-map
("U" . 0x0-dwim)
:map embark-buffer-map
("g" . embark-magit-status)
:map embark-file-map
("g" . embark-magit-status)
("s" . sudo-find-file))
:custom
;; Optionally replace the key help with a completing-read interface
(prefix-help-command #'embark-prefix-help-command)
(embark-indicators '(embark-mixed-indicator
embark-highlight-indicator))
(embark-verbose-indicator-excluded-actions
'("\\`customize-" "\\(local\\|global\\)-set-key"
set-variable embark-cycle embark-keymap-help embark-isearch))
(embark-verbose-indicator-buffer-sections
`(target "\n" shadowed-targets " " cycle "\n" bindings))
(embark-mixed-indicator-both nil)
(embark-mixed-indicator-delay 5)
(embark-verbose-indicator-display-action nil)
:config
(define-key embark-file-map
(kbd "o") (my/embark-ace-action find-file))
(define-key embark-buffer-map
(kbd "o") (my/embark-ace-action switch-to-buffer))
(define-key embark-bookmark-map
(kbd "o") (my/embark-ace-action bookmark-jump))
(define-key embark-file-map
(kbd "2") (my/embark-split-action find-file split-window-below))
(define-key embark-buffer-map
(kbd "2") (my/embark-split-action switch-to-buffer split-window-below))
(define-key embark-bookmark-map
(kbd "2") (my/embark-split-action bookmark-jump split-window-below))
(define-key embark-file-map
(kbd "3") (my/embark-split-action find-file split-window-right))
(define-key embark-buffer-map
(kbd "3") (my/embark-split-action switch-to-buffer split-window-right))
(define-key embark-bookmark-map
(kbd "3") (my/embark-split-action bookmark-jump split-window-right))
(unless
(alist-get 'munyoki/insert-string
embark-target-injection-hooks)
(push 'embark--ignore-target
(alist-get 'munyoki/insert-string
embark-target-injection-hooks)))
;; Hide the mode line of the Embark live/completions buffers
(add-to-list 'display-buffer-alist
'("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
nil
(window-parameters (mode-line-format . none)))))
(use-package embark-consult
:ensure t
:after (embark consult)
:demand t ; only necessary if you have the hook below
;; if you want to have consult previews as you move around an
;; auto-updating embark collect buffer
:hook
(embark-collect-mode . consult-preview-at-point-mode))
(use-package emmet-mode
:mode ("\\.html\\'" "\\.hbs\\'" "\\.erb\\'")
:ensure t
:delight
:hook ((sgml-mode-hook . emmet-mode)
(web-mode-hook . emmet-mode)
(css-mode-hook . emmet-mode)))
(use-package emms
:ensure t
:config
(require 'emms-setup)
(emms-all)
(emms-default-players))
(use-package emojify
:ensure t)
(use-package f
:ensure t)
(use-package gemini-mode
:ensure t
:delight
:mode "\\.gmi\\'")
(use-package haskell-mode
:ensure t
:delight
:mode "\\.hs\\'")
(use-package helpful
:ensure t)
(use-package highlight-escape-sequences
:ensure t
:config
(hes-mode))
(use-package hledger-mode
:ensure t
:mode ("\\.journal\\'" "\\.hledger\\'")
:custom
(hledger-jfile (concat user-home-directory
"finance/2023.journal")))
(use-package hl-todo
:ensure t
:config
;; Adding a new keyword: TEST.
(add-to-list 'hl-todo-keyword-faces '("TEST" . "#dc8cc3"))
:hook ((text-mode-hook . (lambda () (hl-todo-mode t)))))
(use-package hyperbole
:ensure t
:init
(hyperbole-mode 0))
(use-package imenu
:ensure t
:custom
(imenu-use-markers t)
(imenu-auto-rescan t)
(imenu-auto-rescan-maxout 600000)
(imenu-max-item-length 100)
(imenu-use-popup-menu nil)
(imenu-eager-completion-buffer t)
(imenu-space-replacement " ")
(imenu-level-separator "/")
:bind
(("M-i" . imenu)))
(use-package imenu-list
:ensure
:after imenu
:init
(defun munyoki/imenu-list-dwim (&optional arg)
"Convenience wrapper for `imenu-list'.
Move between the current buffer and a dedicated window with the
contents of `imenu'.
The dedicated window is created if it does not exist, while it is
updated once it is focused again through this command.
With \\[universal-argument] toggle the display of the window."
(interactive "P")
(if arg
(imenu-list-smart-toggle)
(with-current-buffer
(if (eq major-mode 'imenu-list-major-mode)
(pop-to-buffer (other-buffer (current-buffer) t))
(imenu-list))))))
(use-package legalese
:ensure t)
(use-package lispy
:ensure t
:hook ((emacs-lisp-mode-hook
lisp-mode-hook
clojure-mode-hook
scheme-mode-hook
sly-mrepl-mode-hook) . lispy-mode))
(use-package magit
:requires (diff-hl magit-patch-changelog org orgit-rev orgit)
:ensure t
:init
(defun magit-status-fullscreen (prefix)
(interactive "P")
(magit-status)
(unless prefix
(delete-other-windows)))
:custom
(magit-pushq-always-verify nil)
;; (set-default 'magit-revert-buffers 'silent)
(magit-no-confirm '(stage-all-changes
unstage-all-changes))
(magit-diff-refine-hunk t)
:config
(with-eval-after-load 'magit
(require 'magit-patch-changelog))
:hook ((git-commit-mode-hook . (lambda ()
(beginning-of-buffer)
(when (looking-at "#")
(forward-line 2))))
(magit-post-refresh-hook . diff-hl-magit-post-refresh))
:bind (("C-x g" . magit-status)
("C-x M-g" . magit-dispatch)))
(use-package magit-patch-changelog
:requires magit
:ensure t)
(use-package marginalia
:after vertico
:ensure t
:custom
(marginalia-annotators '(marginalia-annotators-heavy marginalia-annotators-light nil))
:init
(marginalia-mode)
:bind (("M-A" . marginalia-cycle)
:map minibuffer-local-map
("M-A" . marginalia-cycle)))
(use-package markdown-mode
:ensure t
:delight
:mode "\\.md\\'")
(use-package magit-todos
:ensure t
:after magit
:after hl-todo)
(use-package move-text
:ensure t
:config
(move-text-default-bindings))
(use-package mpv
:ensure t
:config
(org-add-link-type "mpv" #'mpv-play)
(defun org-mpv-complete-link (&optional arg)
(replace-regexp-in-string
"file:" "mpv:"
(org-file-complete-link arg)
t t))
(add-hook 'org-open-at-point-functions #'mpv-seek-to-position-at-point))
(use-package multiple-cursors
:ensure t
:bind (("C-S-c C-S-c" . mc/edit-lines)
("C->" . mc/mark-next-like-this)
("C-<" . mc/mark-previous-like-this)
("C-c C-<" . mc/mark-all-like-this)
("C-S-<mouse-1>" . mc/add-cursor-on-click)))
;; open epubs
(use-package nov
:ensure t
:delight
:mode ("\\.epub\\'" . nov-mode)
:init
(require 'shrface)
:custom
(nov-text-width t)
(visual-fill-column-center-text t)
(nov-shr-rendering-functions
'((img . nov-render-img) (title . nov-render-title)))
(nov-shr-rendering-functions
(append nov-shr-rendering-functions shr-external-rendering-functions))
:hook ((nov-mode-hook . #'munyoki/set-50-char)
(nov-mode-hook . #'shrface-mode)
(nov-post-html-render-hook . #'munyoki/set-50-char)
(nov-post-html-render-hook . #'shrface-mode)))
(use-package orderless
:ensure t
:custom
(completion-styles '(orderless))
(completion-category-defaults nil)
(completion-category-overrides '((file (styles partial-completion)))))
(use-package pass
:ensure t)
(use-package password-generator
:ensure t)
(use-package password-store
:ensure t
:bind (("C-c h p" . password-store-copy)
("C-c h e" . password-store-edit)
("C-c h i" . password-store-insert)
("C-c h r" . password-store-rename)
("C-c h g s" . password-generator-strong)
("C-c h g w" . password-generator-simple)
("C-c h g p" . password-generator-paranoid)))
(add-to-list 'auto-mode-alist '("\\.pdf\\'" . pdf-view-mode))
(use-package pdf-tools
:ensure t
:delight
:load-path "site-lisp/pdf-tools/lisp"
:mode ("\\.pdf\\'" . pdf-view-mode)
:magic ("%PDF" . pdf-view-mode)
:requires tablist
:bind (:map pdf-view-mode-map
(("M-g g" . pdf-view-goto-page)
("M-g M-g" . pdf-view-goto-page)))
:custom
(pdf-tools-enabled-modes ; simplified from the defaults
'(pdf-history-minor-mode
pdf-isearch-minor-mode
pdf-links-minor-mode
pdf-outline-minor-mode
pdf-annot-minor-mode
pdf-misc-size-indication-minor-mode
pdf-occur-global-minor-mode))
(pdf-view-display-size 'fit-height)
(pdf-view-continuous t)
(pdf-view-use-dedicated-register nil)
(pdf-view-max-image-width 4000)
(pdf-outline-imenu-use-flat-menus t)
:config
(pdf-tools-install)
(pdf-loader-install)
:hook ((pdf-view-mode-hook . (lambda() (progn
(pdf-outline-minor-mode 1)
(pdf-isearch-minor-mode 1))))
(TeX-after-compilation-finished-functions . #'TeX-revert-document-buffer)))
;; This doubles as a quick way to avoid the common formula: C-x b RET
;; *scratch*]+
(use-package persistent-scratch
:ensure t
:config
(persistent-scratch-setup-default))
(use-package projectile
:ensure t
:config
(projectile-mode)
:bind-keymap
("C-c p" . projectile-command-map)
:chords ((",p" . projectile-command-map)))
(use-package pylint
:ensure t)
(use-package py-autopep8
:ensure t)
(use-package rcirc
:ensure t
:init
(defun rcirc-handler-301 (process cmd sender args)
"/away message handler.")
:custom
(rcirc-server-alist
'(("irc.libera.chat"
:port 6697
:encryption tls
:channels ("#guix"
"#emacs"
"#nairobilug"
"#whereiseveryone"
"#nonguix"
"#guile-steel"
"#ilugc"
"#fsf")
:user-name "bonz060"
:nick "bonz060")))
(rcirc-debug-flag t)
;; Include date in time stamp.
(rcirc-time-format "%Y-%m-%d %H:%M ")
;; Change user info
(rcirc-default-nick "bonz060")
(rcirc-default-user-name "bonz060")
(rcirc-default-full-name "bonz060")
:hook ((rcirc-mode-hook . (lambda ()
(set (make-local-variable 'scroll-conservatively)
8192)))
(rcirc-mode-hook . (lambda ()
(rcirc-track-minor-mode 1))))
:config
;; Adjust the colours of one of the faces.
(set-face-foreground 'rcirc-my-nick "red" nil))
(use-package rg
:ensure t)
(use-package savehist
:init
(savehist-mode))
(use-package shrface
:ensure t
:defer t
:custom
(shrface-href-versatile t)
:config
(shrface-basic)
(shrface-trial))
(use-package smart-forward
:ensure t
:bind (("M-S-<up>" . smart-up)
("M-S-<down>" . smart-down)
("M-S-<left>" . smart-backward)
("M-S-<right>" . smart-forward)))
(use-package smartparens
:ensure t
:delight
:init
(require 'smartparens-config)
(smartparens-global-mode))
(use-package smartparens-config
:ensure smartparens
:config
(show-smartparens-global-mode t)
:hook ((prog-mode-hook . turn-on-smartparens-strict-mode)
(markdown-mode-hook . turn-on-smartparens-strict-mode)))
(use-package switch-window
:ensure t
:bind (("C-x 1" . switch-window-then-maximize)
("C-x 2" . switch-window-then-split-below)
("C-x 3" . switch-window-then-split-right)
("C-x 0" . switch-window-then-delete)
("C-x 4 d" . switch-window-then-dired)
("C-x 4 f" . switch-window-then-find-file)
("C-x 4 m" . switch-window-then-compose-mail)
("C-x 4 r" . switch-window-then-find-file-read-only)
("C-x 4 C-f" . switch-window-then-find-file)
("C-x 4 C-o" . switch-window-then-display-buffer)
("C-x 4 0" . switch-window-then-kill-buffer)))
(use-package vertico
:ensure t
:init
(vertico-mode)
(defun +vertico-restrict-to-matches ()
(interactive)
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert " ")
(add-text-properties (minibuffer-prompt-end) (point-max)
'(invisible t read-only t cursor-intangible t rear-nonsticky t))))
:custom
(vertico-cycle t)
(completion-styles '(substring orderless))
(completion-in-region-function
(lambda (&rest args)
(apply (if vertico-mode
#'consult-completion-in-region
#'completion--in-region)
args)))
:bind (:map vertico-map
("?" . minibuffer-completion-help)
("M-RET" . minibuffer-force-complete-and-exit)
("M-TAB" . minibuffer-complete)
("S-SPC" . +vertico-restrict-to-matches)
:map minibuffer-local-map
("M-h" . backward-kill-word)))
(defvar-local consult-toggle-preview-orig nil)
(defun consult-toggle-preview ()
"Command to enable/disable preview."
(interactive)
(if consult-toggle-preview-orig
(setq consult--preview-function consult-toggle-preview-orig
consult-toggle-preview-orig nil)
(setq consult-toggle-preview-orig consult--preview-function
consult--preview-function #'ignore)))
;; Bind to `vertico-map' or `selectrum-minibuffer-map'
(define-key vertico-map (kbd "M-P") #'consult-toggle-preview)
(use-package notmuch
:ensure t
:config
(defun munyoki/notmuch-show-view-as-patch ()
"View the the current message as a patch."
(interactive)
(let* ((id (notmuch-show-get-message-id))
(msg (notmuch-show-get-message-properties))
(part (notmuch-show-get-part-properties))
(subject (concat "Subject: " (notmuch-show-get-subject) "\n"))
(diff-default-read-only t)
(buf (get-buffer-create (concat "*notmuch-patch-" id "*")))
(map (make-sparse-keymap)))
(define-key map "q" 'notmuch-bury-or-kill-this-buffer)
(switch-to-buffer buf)
(let ((inhibit-read-only t))
(erase-buffer)
(insert subject)
(insert (notmuch-get-bodypart-text msg part nil)))
(set-buffer-modified-p nil)
(diff-mode)
(lexical-let ((new-ro-bind (cons 'buffer-read-only map)))
(add-to-list 'minor-mode-overriding-map-alist new-ro-bind))
(goto-char (point-min))))
:custom
(notmuch-saved-searches
'((:name "inbox" :query "tag:inbox" :key "i")
(:name "unread" :query "tag:unread" :key "u")
(:name "flagged" :query "tag:flagged" :key "F")
(:name "sent" :query "tag:sent" :key "t")
(:name "drafts" :query "tag:draft" :key "d")
(:name "all mail" :query "*" :key "a")
(:name "strathmore:unread" :query "to:[email protected] tag:unread NOT to:[email protected] NOT to:[email protected] NOT from:[email protected]" :key "s")
(:name "fastmail:unread" :query "tag:unread to:[email protected] NOT to:\"/*github.com\" NOT from:*github.com NOT from:*nairobigarage.com NOT from:*gitlab.com NOT to:\"/*gitlab.com/\" NOT to:\"/*googlegroups.com/\"" :key "f")
(:name "gmail:unread" :query "tag:unread to:[email protected] -to:[email protected] -from:*lwn.net -from:*lists.kictanet.or.ke -from:*sc.com -from:*gnu.org -from:*bolt.eu -from:*uber.com -from:[email protected] -from:[email protected] -from:[email protected] -from:[email protected] -from:*guru.com -from:*wise.com -from:*google.com -from:*libera.chat -from:*github.com -from:*docs.google.com -from:*gitlab.com -to:\"/*github.com\" -to:\"/*gitlab.com/\" -to:\"/*googlegroups.com/\" -from:-arifu.com -from:*imbank.co.ke -from:*wakingup.com -from:*airbnb.com -from:*isoc.org -from:*matrix.org -from:*kra.go.ke -from:*twitter.com -from:*cicinsurancegroup.com -from:*writethedocs.org -from:*fermatslibrary.com" :key "g")
(:name "GNU:unread" :query "tag:unread (to:\"/*gnu.org/\" OR to:\"/*googlegroups.com/\")")
(:name "git:unread" :query "tag:unread (from:*github.com OR from:*gitlab.com OR to:\"/*github.com\" OR to:\"/*gitlab.com/\")")
(:name "NairobiGarage:unread" :query "from:*nairobigarage.com tag:unread")
(:name "LWN" :query "from:*lwn.net tag:unread")
(:name "kictanet:unread" :query "(from:*lists.kictanet.or.ke OR to:/\"*lists.kictanet.or.ke\"/) tag:unread" :key "k")
(:name "alerts:unread" :query "tag:unread from:*sc.com from:*bolt.eu from:*uber.com from:*guru.com from:*wise.com from:*google.com from:*libera.chat from:*twitter.com from:*cicinsurancegroup.com from:*imbank.co.ke")
(:name "su-allstudents:unread" :query "to:[email protected] tag:unread")
(:name "su-mscdsa2021:unread" :query "to:[email protected] tag:unread")
(:name "Newsletters:unread" :query "from:[email protected] tag:unread from:[email protected] from:[email protected] from:[email protected] from:*kra.go.ke from:*isoc.org from:*airbnb.com from:*wakingup.com from:*arifu.com from:*writethedocs.org from:*fermatslibrary.com")
(:name "Matrix:unread" :query "from:*matrix.org tag:unread")
(:name "KLDP" :query "from:*redhat.com from:*kdlp.underground.software tag:unread")
(:name "daziri:unread" :query "tag:unread to:[email protected]")))
(mm-encrypt-option nil)
(mm-sign-option nil)
(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)
(epa-file-cache-passphrase-for-symmetric-encryption nil)
(mail-user-agent 'message-user-agent)
(compose-mail-user-agent-warnings nil)
(message-mail-user-agent t)
(message-confirm-send nil)
(message-kill-buffer-on-exit t)
(message-wide-reply-confirm-recipients t)
(notmuch-fcc-dirs "Sent")
(gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3")
(mm-discouraged-alternatives '("text/html" "text/richtext"))
(mm-automatic-display (remove "text/html" mm-automatic-display))
(send-mail-function 'message-send-mail-with-sendmail)
(sendmail-program (executable-find "msmtp"))
(mail-specify-envelope-from t)
(message-sendmail-envelope-from 'header)
(mail-envelope-from 'header)
(message-kill-buffer-on-exit t)
(notmuch-search-oldest-first nil)
:bind (:map notmuch-show-part-map
("d" . munyoki/notmuch-show-view-as-patch)))
(add-hook 'gnus-message-setup-hook #'mml-secure-message-sign-pgpmime)
(add-hook 'message-setup-hook #'mml-secure-message-sign-pgpmime)
(add-hook 'message-setup-hook #'message-sort-headers)
(add-hook 'message-mode-hook #'(lambda ()
(progn
(setq-local writegood-mode 1)
(setq-local fill-column 50))))
(defun munyoki/message-insert-citation-line ()
"Insert a simple citation line."
(when message-reply-headers
(insert (mail-header-from message-reply-headers) " aliandika:")
(newline)
(newline)))
(setq message-citation-line-function 'munyoki/message-insert-citation-line)
(defun munyoki/notmuch-show-view-as-patch ()
"View the the current message as a patch."
(interactive)
(let* ((id (notmuch-show-get-message-id))
(msg (notmuch-show-get-message-properties))
(part (notmuch-show-get-part-properties))
(subject (concat "Subject: " (notmuch-show-get-subject) "\n"))
(diff-default-read-only t)
(buf (get-buffer-create (concat "*notmuch-patch-" id "*")))
(map (make-sparse-keymap)))
(define-key map "q" 'notmuch-bury-or-kill-this-buffer)
(switch-to-buffer buf)
(let ((inhibit-read-only t))
(erase-buffer)
(insert subject)
(insert (notmuch-get-bodypart-text msg part nil)))
(set-buffer-modified-p nil)
(diff-mode)
(lexical-let ((new-ro-bind (cons 'buffer-read-only map)))
(add-to-list 'minor-mode-overriding-map-alist new-ro-bind))
(goto-char (point-min))))
(use-package ol-notmuch :ensure t)
;; Configure directory extension.
(use-package vertico-directory
:after vertico
:ensure nil
;; More convenient directory navigation commands
:bind (:map vertico-map
("RET" . vertico-directory-enter)
("M-l" . vertico-directory-delete-char)
("C-l" . vertico-directory-delete-word))
;; Tidy shadowed file names
:hook (rfn-eshadow-update-overlay . vertico-directory-tidy))
(use-package web-mode
:mode ("\\.html\\'" "\\.hbs\\'" "\\.erb\\'")
:delight
:ensure t
:hook ((web-mode-hook . visual-line-mode)))
(use-package which-key
:ensure t
:delight
:custom
(which-key-show-early-on-C-h t)
(which-key-idle-delay 10000)
(which-key-idle-secondary-delay 0.05)
:init (which-key-mode)
:config (which-key-setup-side-window-bottom))
(use-package writegood-mode
:ensure t)
(use-package writeroom-mode
:ensure t)
(use-package wordnut
:ensure t)
(use-package xclip
:ensure t
:delight
:config
(xclip-mode 1))
(use-package yaml-mode
:mode ("\\.yml\\'" . yaml-mode)
:ensure t)
(use-package yasnippet
:ensure t
:diminish yas-minor-mode
:custom
(yas-indent-line 'fixed)
:config
(yas-global-mode 1))
(use-package yasnippet-snippets
:ensure t)
(use-package zoom-window
:custom
(zoom-window-mode-line-color "DarkGreen")
:ensure t
:bind (("C-x C-z" . zoom-window-zoom)))
;; Custom Configs
(use-package eshell
:init
;; Prompt with a bit of help from http://www.emacswiki.org/emacs/EshellPrompt
(defmacro with-face (str &rest properties)
`(propertize ,str 'face (list ,@properties)))
(defun eshell/abbr-pwd ()
(let ((home (getenv "HOME"))
(path (eshell/pwd)))
(cond
((string-equal home path) "~")
((f-ancestor-of? home path) (concat "~/" (f-relative path home)))
(path))))
(defun eshell/my-prompt ()
(let ((header-bg "#161616"))
(concat
(with-face (eshell/abbr-pwd) :foreground "#008700")
(if (= (user-uid) 0)
(with-face "#" :foreground "red")
(with-face "$" :foreground "#2345ba"))
" ")))
:custom
(eshell-visual-commands
'("less" "tmux" "htop" "top" "bash" "zsh" "fish"))
(eshell-visual-subcommands
'(("git" "log" "l" "diff" "show")))
(eshell-prompt-function 'eshell/my-prompt)
(eshell-highlight-prompt nil)
(eshell-prompt-regexp "^[^#$\n]+[#$] ")
(eshell-cmpl-cycle-completions nil)
:config
(add-hook 'eshell-load-hook #'eat-eshell-mode)
(eval-after-load 'eshell
'(require 'eshell-autojump nil t)))
(use-package eww
:defer t
:init
(require 'shrface)
:hook
((eww-mode-hook . munyoki/set-50-char)
(eww-after-render-hook . #'shrface-mode)))
(use-package munyoki/isearch
:init
;; Isearch in other windows
(defun isearch-forward-other-window (prefix)
"Function to isearch-forward in other-window."
(interactive "P")
(unless (one-window-p)
(save-excursion
(let ((next (if prefix -1 1)))
(other-window next)
(isearch-forward)
(other-window (- next))))))
(defun isearch-backward-other-window (prefix)
"Function to isearch-backward in other-window."
(interactive "P")
(unless (one-window-p)
(save-excursion
(let ((next (if prefix 1 -1)))
(other-window next)
(isearch-backward)
(other-window (- next))))))
:bind (("C-M-s" . isearch-forward-other-window)
("C-M-r" . isearch-backward-other-window)))
(use-package slime
:ensure t
:mode ("\\.lisp\\'")
:custom
(inferior-lisp-program "sbcl")
;; :config
(load (expand-file-name "~/.quicklisp/slime-helper.el"))
:hook ((lisp-mode-hook . (lambda () (slime-mode t)))
(inferior-lisp-mode-hook . (lambda () (inferior-slime-mode t)))))
(use-package emacs
:init
(require 'magit-git)
(defun munyoki/magit-check-file-and-popup ()
"If the file is version controlled with git
and has uncommitted changes, open the magit status popup."
(let ((file (buffer-file-name)))
(when (and file (magit-anything-modified-p t file))
(message "This file has uncommited changes!")
(when nil ;; Became annoying after some time.
(split-window-below)
(other-window 1)
(magit-status)))))
(defun crm-indicator (args)
(cons (concat "[CRM] " (car args)) (cdr args)))
(advice-add #'completing-read-multiple :filter-args #'crm-indicator)
:custom
(switch-to-buffer-obey-display-actions t)
(global-page-break-lines-mode 1)
(auto-revert-verbose t)
(column-number-mode t)
(custom-safe-themes t)
(default-input-method 'TeX)
(delete-by-moving-to-trash t)
(ediff-window-setup-function 'ediff-setup-windows-plain)
(enable-recursive-minibuffers t)
(epa-pinentry-mode 'loopback)
(gc-cons-threshold 100000000)
(global-auto-revert-non-file-buffers nil)
(history-length 100)
(ibuffer-show-empty-filter-groups -1)
(indicate-empty-lines 1)
(inhibit-splash-screen t)
(initial-major-mode 'org-mode)
(initial-scratch-message (concat
"#+Title: Persistent Scratch Buffer\n#\n"
"# There is no system but GNU and Linux "
"is one of it's kernels\n"))
(inhibit-splash-screen 1)
(jump-char-lazy-highlight-face -1)
(make-backup-files -1)
(minibuffer-prompt-properties
'(read-only t cursor-intangible t face minibuffer-prompt))
(python-indent 4)
(read-process-output-max (* 1024 1024)) ;; 1mb
(recentf-max-menu-items 25)
(recentf-max-saved-items 100)
(repeat-mode t)
(require-final-newline t)
(set-mark-command-repeat-pop t)
(shell-file-name
(concat user-home-directory
".guix-profile/bin/zsh"))
(show-trailing-whitespace nil)
(shr-width 50)
(size-indication-mode t)
(sp-autoescape-string-quote nil)
(tramp-chunksize 500)
(tramp-default-method "ssh")
(use-dialog-box nil)
(use-file-dialog nil)
(use-short-answers t)
(visible-bell t)
(w3m-fill-column 50)
(w3m-search-default-engine "duckduckgo")
(x-select-enable-clipboard t)
(world-clock-list
'(("CET-1CDT" "Amsterdam/ Paris")
("CDT+5" "Memphis")
("EST5EDT" "New York/ Miami")
("GMT0BST" "London")
("IST-5:30" "Bangalore")
("PST8PDT" "Seattle")
("JST-9" "Tokyo")))
:init
(auto-compression-mode 1)
; (auto-save-default t)
(column-number-mode nil)
(delete-selection-mode 1)
(display-battery-mode)
(display-time)
(display-time-mode t)
(doom-modeline-mode)
(fringe-mode 7)
(global-auto-revert-mode 1)
(global-hl-line-mode t)
(global-prettify-symbols-mode -1)
(global-subword-mode 1)
(global-visual-line-mode)
(menu-bar-mode -1)
(scroll-bar-mode -1)
(show-paren-mode 1)
(size-indication-mode 1)
(tab-bar-mode -1)
(tool-bar-mode -1)
(transient-mark-mode 1)
(winner-mode 1) ; Undo/redo window configuration with C-c <left>/<right>
(global-display-line-numbers-mode -1)
:hook ((minibuffer-setup-hook . cursor-intangible-mode)
(after-save-hook . executable-make-buffer-file-executable-if-script-p)
(prog-mode-hook . (lambda ()
(setq show-trailing-whitespace 1)
(setq display-line-numbers-type 'relative)
(display-line-numbers-mode 1)))
(find-file-hook . (lambda ()
(add-hook 'hack-local-variables-hook 'munyoki/magit-check-file-and-popup)))
(server-switch-hook . magit-commit-diff))
:config
;; make a shell script executable automatically on save
(add-to-list 'auto-mode-alist '("\\.zsh$" . shell-script-mode))
;; conf-mode
(add-to-list 'auto-mode-alist '("\\.gitconfig$" . conf-mode))
;; yaml
(add-to-list 'auto-mode-alist '("\\.yml$" . yaml-mode))
(add-to-list 'auto-mode-alist '("\\.yaml$" . yaml-mode))
;; PHP
(add-to-list 'auto-mode-alist '("\\.php$" . php-mode))
;; Golang
(add-to-list 'auto-mode-alist '("\\.go\\'" . go-mode))
(add-to-list 'auto-mode-alist '("\\info.gz$" . info-mode))
(add-to-list 'auto-mode-alist '("\\.\\(org\\|org_archive\\)$" . org-mode))
(define-key ac-mode-map (kbd "M-TAB") 'auto-complete)
:bind (("C-g" . keyboard-quit-strong)
("C-+" . text-scale-increase)
("C--" . text-scale-decrease)
("C-x C-b" . ibuffer)
("C-x f" . recentf-open-files)
("C-x c l" . magit-generate-changelog)
("s-n" . rename-buffer)))
;; Aliases
(defalias 'yes-or-no-p 'y-or-n-p) ; y or n is enough
(setq browse-url-browser-function 'browse-url-generic
browse-url-generic-program "qutebrowser")
(provide 'sane-defaults)
;;; sane-defaults.el ends here;;; appearance.el
(create-directory-if-nonexistent
(expand-file-name "themes" user-emacs-directory))
(when (display-graphic-p)
(tooltip-mode -1)
(blink-cursor-mode -1))
(setq munyoki/default-font
"-UKWN-Atkinson Hyperlegible-normal-normal-expanded-*-13-*-*-*-d-0-iso10646-1")
;; Some Cool fonts to consider in future:
;; - Fira Code-13
;; - DejaVu Sans Mono-12
(add-to-list 'default-frame-alist
'(font . "Iosevka Comfy Wide-12"))
;; Configure the Modus Themes' appearance
(setq modus-themes-mode-line '(accented borderless)
modus-themes-bold-constructs t
modus-themes-italic-constructs t
modus-themes-fringes 'subtle
modus-themes-tabs-accented t
modus-themes-paren-match '(bold intense)
modus-themes-prompts '(bold intense)
modus-themes-org-blocks 'tinted-background
modus-themes-scale-headings t
modus-themes-region '(bg-only)
modus-themes-headings
'((1 . (rainbow overline background 1.4))
(2 . (rainbow background 1.3))
(3 . (rainbow bold 1.2))
(t . (semilight 1.1))))
;; Load the dark theme by default
(load-theme 'modus-vivendi t)
(use-package ef-themes :ensure)
;; (load-theme 'ef-tritanopia-dark t)
(use-package all-the-icons
:ensure t
:delight)
;; Colour parens, and other delimiters, depending on their depth.
;; Very useful for parens heavy languages like Lisp.
(use-package rainbow-delimiters
:ensure t
:delight
:hook ((org-mode-hook . (lambda () (rainbow-delimiters-mode 1)))
(prog-mode-hook . (lambda () (rainbow-delimiters-mode 1)))))
(use-package dimmer
:ensure t
:delight
:custom
(dimmer-fraction 0.2))
(provide 'appearance)
;;; appearance.el ends here ;;; setup-elfeed.el
(use-package elfeed
:ensure t
:custom
(elfeed-search-title-max-width 150)
(elfeed-search-trailing-width 30)
(elfeed-search-filter "@1-week-ago +unread ")
(elfeed-feeds
'(;; Normal blogs
("https://jnduli.co.ke/feeds/all.atom.xml" blog)
("https://memo.barrucadu.co.uk/atom.xml" blog)
("https://ambrevar.xyz/atom.xml" blog)
("http://feeds.feedburner.com/typepad/sethsmainblog" blog)
("http://www.aaronsw.com/2002/feeds/pgessays.rss" blog)
("https://blog.khinsen.net/feeds/all.rss.xml" blog)
("https://blog.tecosaur.com/tmio/rss.xml" blog)
("https://daneden.me/rss.xml" blog)
("https://danluu.com/atom.xml" blog)
("https://daverupert.com/atom.xml" blog)
("https://drewdevault.com/blog/index.xml" blog)
("https://eli.thegreenplace.net/feeds/all.atom.xml" blog)
("https://emacsair.me/feed.xml" blog)
("https://emacstil.com/feed.xml" blog)
("https://jarango.com/feed" blog)
("https://lars.ingebrigtsen.no/rss" blog)
("https://occasionallycogent.com/feed.xml" blog)
("https://overreacted.io/rss.xml" blog)
("https://takeonrules.com/index.xml" blog)
("https://twobithistory.org/feed.xml" blog)
("https://www.arp242.net/feed.xml" blog)
("https://www.benkuhn.net/index.xml" blog)
("www.roughtype.com/?feed=rss2" blog)
("https://jvns.ca/atom.xml" blog)
;; Misc
("https://upbookclub.com/latest.rss" misc)
;; Newsletters
("https://www.lesswrong.com/feed.xml?view=curated-rss" newsletter)
("https://www.quastor.org/feed" newsletter)
;; Podcasts
("https://fossandcrafts.org/rss-feed-ogg.rss" podcast)
;; News
("http://rss.slashdot.org/slashdot/eqWf" news)
;; Emacs
("https://updates.orgmode.org/feed/updates" emacs)
("https://jao.io/blog/rss.xml" emacs)
("https://emacsredux.com/atom.xml" emacs)
("http://emacsrocks.com/atom.xml" emacs)
("https://cestlaz.github.io/rss.xml" emacs)
("http://blog.binchen.org/rss.xml" emacs)
("http://www.howardism.org/index.xml" emacs)
("http://irreal.org/blog/?feed=rss2" emacs)
("http://mbork.pl/?action=rss" emacs)
("https://www.masteringemacs.org/feed" emacs)
("https://fuco1.github.io/rss.xml" emacs)
("https://longreads.com/feed/")
("https://nullprogram.com/feed/" emacs)
("https://scripter.co/posts/index.xml" emacs)
("http://pragmaticemacs.com/feed/" emacs)
("http://www.lunaryorn.com/feed/" emacs)
("http://endlessparentheses.com/atom.xml" emacs)
("https://sachachua.com/blog/feed/" emacs)
;; Comics
("https://xkcd.com/atom.xml" comic)
("https://www.drugsandwires.fail/feed/" comic)
("http://feeds.feedburner.com/Explosm" comic)
("https://www.foxtrot.com/feed/" comic)
("http://feeds.feedburner.com/PoorlyDrawnLines" comic)))
:config
(defun actuator-elfeed-show-all ()
(interactive)
(bookmark-maybe-load-default-file)
(bookmark-jump "elfeed-all"))
(defun actuator-elfeed-show-unread ()
(interactive)
(bookmark-maybe-load-default-file)
(bookmark-jump "elfeed-unread"))
(defun actuator-elfeed-load-db-and-open ()
"Wrapper to load the elfeed database from disk before
opening. Taken from Pragmatic Emacs."
(interactive)
(window-configuration-to-register :elfeed-fullscreen)
(delete-other-windows)
(elfeed)
(elfeed-db-load)
(elfeed-search-update 1)
(elfeed-update))
(defun actuator-elfeed-save-db-and-bury ()
"Wrapper to save the Elfeed database to disk before burying
buffer. Taken from Pragmatic Emacs."
(interactive)
(elfeed-db-save)
(quit-window)
(garbage-collect)
(jump-to-register :elfeed-fullscreen))
(defun actuator-elfeed-mark-all-as-read ()
"Mark all feeds in search as read. Taken from Mike Zamansky"
(interactive)
(mark-whole-buffer)
(elfeed-search-untag-all-unread))
(defun email-elfeed-entry ()
"Capture the elfeed entry and put it in an email."
(interactive)
(let* ((title (elfeed-entry-title elfeed-show-entry))
(url (elfeed-entry-link elfeed-show-entry))
(content (elfeed-entry-content elfeed-show-entry))
(entry-id (elfeed-entry-id elfeed-show-entry))
(entry-link (elfeed-entry-link elfeed-show-entry))
(entry-id-str (concat (car entry-id)
"|"
(cdr entry-id)
"|"
url)))
(compose-mail)
(message-goto-subject)
(insert title)
(message-goto-body)
(insert (format "You may find this interesting:
%s\n\n" url))
(insert (elfeed-deref content))
(message-goto-body)
(while (re-search-forward "<br>" nil t)
(replace-match "\n\n"))
(message-goto-body)
(while (re-search-forward "<.*?>" nil t)
(replace-match ""))
(message-goto-body)
(fill-region (point) (point-max))
(message-goto-to)))
(defun org-elfeed-open (path)
"Open an elfeed link to PATH."
(cond
((string-match "^entry-id:\\(.+\\)" path)
(let* ((entry-id-str (substring-no-properties (match-string 1 path)))
(parts (split-string entry-id-str "|"))
(feed-id-str (car parts))
(entry-part-str (cadr parts))
(entry-id (cons feed-id-str entry-part-str))
(entry (elfeed-db-get-entry entry-id)))
(elfeed-show-entry entry)))
(t (error "%s %s" "elfeed: Unrecognised link type - " path))))
(defun org-elfeed-store-link ()
"Store a link to an elfeed entry."
(interactive)
(cond
((eq major-mode 'elfeed-show-mode)
(let* ((title (elfeed-entry-title elfeed-show-entry))
(url (elfeed-entry-link elfeed-show-entry))
(entry-id (elfeed-entry-id elfeed-show-entry))
(entry-id-str (concat (car entry-id)
"|"
(cdr entry-id)
"|"
url))
(org-link (concat "elfeed:entry-id:" entry-id-str)))
(org-link-store-props
:description title
:type "elfeed"
:link org-link
:url url
:entry-id entry-id)
org-link))
(t nil)))
(org-link-set-parameters
"elfeed"
:follow 'org-elfeed-open
:store 'org-elfeed-store-link)
(defface newsletter-elfeed-entry
'((t :foreground "thistle1"))
"Marks a newsletter Elfeed entry."
:group 'bonz-elfeed)
(push '(newsletter newsletter-elfeed-entry)
elfeed-search-face-alist)
(defface misc-elfeed-entry
'((t :foreground "tan1"))
"Marks a misc Elfeed entry."
:group 'bonz-elfeed)
(push '(misc misc-elfeed-entry)
elfeed-search-face-alist)
(defface blog-elfeed-entry
'((t :foreground "khaki"))
"Marks a blog Elfeed entry."
:group 'bonz-elfeed)
(push '(blog blog-elfeed-entry)
elfeed-search-face-alist)
(defface news-elfeed-entry
'((t :foreground "DarkOrange1"))
"Marks a news Elfeed entry."
:group 'bonz-elfeed)
(push '(news news-elfeed-entry)
elfeed-search-face-alist)
(defface github-elfeed-entry
'((t :foreground "DeepSkyBlue"))
"Marks a github Elfeed entry."
:group 'bonz-elfeed)
(push '(github github-elfeed-entry)
elfeed-search-face-alist)
(defface python-elfeed-entry
'((t :foreground "LawnGreen"))
"Marks a python Elfeed entry."
:group 'bonz-elfeed)
(push '(python python-elfeed-entry)
elfeed-search-face-alist)
(defface emacs-elfeed-entry
'((t :foreground "NavajoWhite2"))
"Marks an Emacs Elfeed entry."
:group 'bonz-elfeed)
(push '(emacs emacs-elfeed-entry)
elfeed-search-face-alist)
(defface youtube-elfeed-entry
'((t :foreground "red1"))
"Marks a YouTube Elfeed entry."
:group 'bonz-elfeed)
(push '(youtube youtube-elfeed-entry)
elfeed-search-face-alist)
(defface reddit-elfeed-entry
'((t :foreground "IndianRed1"))
"Marks a Reddit Elfeed entry."
:group 'bonz-elfeed)
(push '(reddit reddit-elfeed-entry)
elfeed-search-face-alist)
;; From http://pragmaticemacs.com/emacs/star-and-unstar-articles-in-elfeed/
(defalias 'elfeed-toggle-star
(elfeed-expose #'elfeed-search-toggle-all 'star))
(eval-after-load 'elfeed-search
'(define-key elfeed-search-mode-map (kbd "m") 'elfeed-toggle-star))
;; face for starred articles
(defface elfeed-search-star-title-face
'((t :foreground "magenta"))
"Marks a starred Elfeed entry.")
(push '(star elfeed-search-star-title-face) elfeed-search-face-alist)
:hook ((org-store-link-functions . #'org-elfeed-entry-store-link))
:bind
(:map elfeed-show-mode-map
("c" . (lambda () (interactive) (org-capture nil "f")))
:map elfeed-search-mode-map
("A" . actuator-elfeed-show-all)
("U" . actuator-elfeed-show-unread)
("q" . actuator-elfeed-save-db-and-bury)
("M" . email-elfeed-entry)
("R" . actuator-elfeed-mark-all-as-read)))
(provide 'setup-elfeed)
;;; end setup-elfeed.el ;;; setup-exwm.el
;; Load exwm
(use-package exwm
:ensure t
:init
(require 'exwm-randr)
;; Add these hooks in a suitable place (e.g., as done in exwm-config-default)
(exwm-input-set-key (kbd "s-r") #'exwm-reset)
;; 's-w': Switch workspace
(exwm-input-set-key (kbd "s-w") #'exwm-workspace-switch)
(dotimes (i 10)
(exwm-input-set-key (kbd (format "s-%d" i))
`(lambda ()
(interactive)
(exwm-workspace-switch-create ,i))))
;; 's-&': Launch application
(exwm-input-set-key (kbd "s-&")
(lambda (command)
(interactive (list (read-shell-command "$ ")))
(start-process-shell-command command nil command)))
(defun exwm-workspace-next ()
(interactive)
(let ((next-numb (mod (+ 1 exwm-workspace-current-index) exwm-workspace-number)))
(exwm-workspace-switch next-numb)))
(defmacro exwm-switch-to-workspace-key (ws-num)
`(progn (exwm-input-set-key (kbd (concat "s-" ,(number-to-string ws-num)))
(lambda ()
(interactive)
(exwm-workspace-switch ,ws-num)))
(let ((key-num (if (eq 0 ,ws-num)
10
,ws-num)))
(exwm-input-set-key (kbd (concat "s-<f" (number-to-string key-num) ">"))
(lambda ()
(interactive)
(exwm-workspace-switch ,ws-num))))))
(add-to-list 'display-buffer-alist
`(,(rx bos " *async command*")
(display-buffer-no-window)))
(defun background-shell-command (command)
(interactive (list (read-shell-command "$ ")))
(async-shell-command command (generate-new-buffer " *async command*")))
(defmacro define-run-or-rise-command (prog)
(let ((Prog (capitalize prog)))
`(defun ,(intern (format "run-or-rise-%s" prog)) ()
,(format "Run or rise %s" Prog)
(interactive)
(if (string= (buffer-name) ,Prog)
(bury-buffer)
(if (get-buffer ,Prog)
(exwm-workspace-switch-to-buffer ,Prog)
(start-process ,prog nil ,prog))))))
(define-run-or-rise-command "nyxt")
(defun exwm-rename-buffer ()
(interactive)
(exwm-workspace-rename-buffer
(concat exwm-class-name ":"
(if (<= (length exwm-title) 7) exwm-title
(concat (substring exwm-title 0 6) "...")))))
;; Enable EXWM
(exwm-enable)
(exwm-randr-enable)
:custom
(exwm-randr-workspace-monitor-plist
'(0 "eDP-1" 0 "HDMI-1" 1 "HDMI-2" 2 "DP-1"))
(exwm-layout-show-all-buffers t)
(exwm-workspace-show-all-buffers t)
(exwm-workspace-number 4)
(exwm-input-simulation-keys
'(([?\C-b] . [left])
([?\C-f] . [right])
([?\C-p] . [up])
([?\C-n] . [down])
([?\C-a] . [home])
([?\C-e] . [end])
([?\M-v] . [prior])
([?\C-v] . [next])
([?\C-d] . [delete])
([?\C-k] . [S-end delete])))
:hook
((exwm-update-class-hook . (lambda ()
(unless (or (string-prefix-p "sun-awt-X11-" exwm-instance-name)
(string= "gimp" exwm-instance-name))
(exwm-workspace-rename-buffer exwm-class-name))))
(exwm-update-title-hook . (lambda ()
(when (or (not exwm-instance-name)
(string-prefix-p "sun-awt-X11-" exwm-instance-name)
(string= "gimp" exwm-instance-name))
(exwm-workspace-rename-buffer exwm-title)))))
:bind (("C-x C-c" . exwm-logout)
("C-c C-l" . exwm-input-release-keyboard)
:map exwm-mode-map
("C-c C-r" . exwm-input-send-next-key)))
(defun munyoki/winner-clean-up-modified-list ()
"Remove dead frames from `winner-modified-list`"
(dolist (frame winner-modified-list)
(unless (frame-live-p frame)
(delete frame winner-modified-list))))
(advice-add 'winner-save-old-configurations :before #'munyoki/winner-clean-up-modified-list)
(provide 'setup-exwm)
;;; setup-exwm.el ends here(require 'org)
(require 'org-clock)
(require 'org-table)
(require 'org-agenda)
(defgroup org-time-budgets nil
"Org time budgets customization."
:tag "Org Time Budgets"
:group 'org-progress)
(defcustom org-time-budgets nil
"The list of time budgets.
See this example:
'((:title \"Business\" :match \"+business\" :budget \"30:00\" :blocks (workday week))
(:title \"Practice Music\" :match \"+practice+music\" :budget \"4:00\" :blocks (nil week))
(:title \"Exercise\" :match \"+exercise\" :budget \"5:00\" :blocks (day)))"
:group 'org-time-budgets
:type 'list)
(defvar org-time-budgets-show-budgets t
"If non-nil, show time-budgets in agenda buffers.")
(defface org-time-budgets-done-face
'((((background light)) (:foreground "#4df946"))
(((background dark)) (:foreground "#228b22")))
"Face for budgets which are fulfilled."
:group 'org-time-budgets
:group 'org-faces)
(defface org-time-budgets-close-face
'((((background light)) (:foreground "#ffc500"))
(((background dark)) (:foreground "#b8860b")))
"Face for budgets which are close to being fulfilled."
:group 'org-time-budgets
:group 'org-faces)
(defface org-time-budgets-todo-face
'((((background light)) (:foreground "#fc7560"))
(((background dark)) (:foreground "#8b0000")))
"Face for budgets which are not yet fulfilled."
:group 'org-time-budgets
:group 'org-faces)
(defun org-time-budgets-minutes-to-string (minutes)
"Return the given MINUTES as string HH:MM."
(let ((secs0 (abs (* minutes 60))))
(org-format-seconds "%.2h:%.2m" secs0)))
(defun org-time-budgets-string-to-minutes (string)
"Return the given STRING of format HH:MM as minutes."
(/ (string-to-number
(org-table-time-string-to-seconds string))
60))
(defun org-time-budgets-bar (width progress goal)
"Create a simple progress bar with WIDTH, displaying the PROGRESS relative to the set GOAL."
(let* ((progress-percent (/ (float progress) (float goal)))
(progress-width (floor (* progress-percent width)))
(progress (make-string (min (max 0 progress-width) width) ?|))
(spacer (make-string (max 0 (- width progress-width)) ?.))
(face (cond
((>= progress-percent 1.0) 'org-time-budgets-done-face)
((> progress-percent 0.7) 'org-time-budgets-close-face)
(t 'org-time-budgets-todo-face))))
(concat
(propertize progress 'face face)
spacer)))
(defun org-time-budgets-time (filters)
"Return the clocked time matching FILTERS in agenda files."
(apply '+
(mapcar (lambda (file)
(nth 1 (save-window-excursion
(find-file file)
(org-clock-get-table-data file filters))))
(org-agenda-files))))
(defun org-time-budgets-format-block (block)
(let ((current (cl-case block
(day (org-time-budgets-time `(:match ,match :block today)))
(workday (org-time-budgets-time `(:match ,match :block today)))
(week (org-time-budgets-time `(:match ,match :tstart ,tstart-s :tend ,tend-s)))))
(budget (cl-case block
(day (/ range-budget 7))
(workday (/ range-budget 5))
(week range-budget))))
(if (and current budget)
(format "[%s] %s / %s"
(org-time-budgets-bar 14 current budget)
(org-time-budgets-minutes-to-string current)
(org-time-budgets-minutes-to-string budget))
" ")))
(defun org-time-budgets-table ()
"List the time budgets in a table."
(let ((title-column-width (apply #'max
(mapcar #'(lambda (budget) (string-width (plist-get budget :title)))
org-time-budgets))))
(mapconcat #'(lambda (budget)
(let* ((title (plist-get budget :title))
(match (or (plist-get budget :match)
(plist-get budget :tags))) ;; support for old :tags syntax
(blocks (or (plist-get budget :blocks)
(cl-case (plist-get budget :block) ;; support for old :block syntax
(week '(day week))
(workweek '(workday week)))
'(day week)))
(trange (org-clock-special-range 'thisweek))
(tstart (nth 0 trange))
(tstart-s (format-time-string "[%Y-%m-%d]" tstart))
(tend (nth 1 trange))
(tend-s (format-time-string "[%Y-%m-%d]" tend))
(days-til-week-ends (ceiling
(time-to-number-of-days
(time-subtract tend (current-time)))))
(range-budget (org-time-budgets-string-to-minutes (plist-get budget :budget))))
(format "%s %s"
(concat
title
(make-string (max 0 (- title-column-width (string-width title))) ?\s))
(mapconcat
#'org-time-budgets-format-block
blocks
" "))))
org-time-budgets
"\n")))
(defun org-time-budgets-in-agenda (arg)
"Insert the `org-time-budget-table' at the top of the current
agenda."
(save-excursion
(let ((agenda-start-day (nth 1 (get-text-property (point) 'org-last-args)))
(inhibit-read-only t))
;; find top of agenda
(while (not (and (get-text-property (point) 'org-date-line)
(equal (get-text-property (point) 'day) agenda-start-day)))
(forward-line -1))
(insert (org-time-budgets-table) "\n\n"))))
(defun org-time-budgets-in-agenda-maybe (arg)
"Return budgets table if org-time-budgets-show-budgets is set."
(when org-time-budgets-show-budgets
(org-time-budgets-in-agenda arg)))
(defun org-time-budgets-toggle-time-budgets ()
"Toggle display of time-budgets in an agenda buffer."
(interactive)
(org-agenda-check-type t 'agenda)
(setq org-time-budgets-show-budgets (not org-time-budgets-show-budgets))
(org-agenda-redo)
(org-agenda-set-mode-name)
(message "Time-Budgets turned %s"
(if org-time-budgets-show-budgets "on" "off")))
;; free agenda-mode-map keys are rare
;; (org-defkey org-agenda-mode-map "V" 'org-time-budgets-toggle-time-budgets)
(provide 'org-time-budgets) ;;; setup-org.el
;; Org-mode
;; Org secretary stuff
(require 'org)
(setq org-time-budgets
'((:title "Genenetwork" :tags "+genenetwork" :budget "30:00" :blocks (workday week))
(:title "Strathmore" :match "+strathmore" :budget "9:00" :blocks (day week))
(:title "Functional Programming" :match "+FP" :budget "7:00" :blocks (day week))
(:title "Daily Reading" :match "+reading" :budget "7:00" :blocks (day week))
(:title "Guix" :match "+guix" :budget "10:00" :blocks (day week))))
(defvar org-sec-me nil
"Tag that defines TASK todo entries associated to me")
(setq org-sec-me "munyoki")
(defvar org-sec-with nil
"Value of the :with: property when doing an
org-sec-tag-entry. Change it with org-sec-set-with,
set to C-c w. Defaults to org-sec-me")
(defvar org-sec-where ""
"Value of the :at: property when doing an
org-sec-tag-entry. Change it with org-sec-set-with,
set to C-c W")
(defvar org-sec-with-history '()
"History list of :with: properties")
(defvar org-sec-where-history '()
"History list of :where: properties")
(defun org-sec-set-with ()
"Changes the value of the org-sec-with variable for use in the
next call of org-sec-tag-entry. Leave it empty to default to
org-sec-me (you)."
(interactive)
(setq org-sec-with (let ((w (read-string "With: " nil
'org-sec-with-history "")))
(if (string= w "")
nil
w))))
(global-set-key "\C-cw" 'org-sec-set-with)
(defun org-sec-set-where ()
"Changes the value of the org-sec-where variable for use
in the next call of org-sec-tag-entry."
(interactive)
(setq org-sec-where
(read-string "Where: " nil
'org-sec-where-history "")))
(global-set-key "\C-cW" 'org-sec-set-where)
(defun org-sec-set-dowith ()
"Sets the value of the dowith property."
(interactive)
(let ((do-with
(read-string "Do with: "
nil 'org-sec-dowith-history "")))
(unless (string= do-with "")
(org-entry-put nil "dowith" do-with))))
(global-set-key "\C-cd" 'org-sec-set-dowith)
(defun org-sec-set-doat ()
"Sets the value of the doat property."
(interactive)
(let ((do-at (read-string "Do at: "
nil 'org-sec-doat-history "")))
(unless (string= do-at "")
(org-entry-put nil "doat" do-at))))
(global-set-key "\C-cD" 'org-sec-set-doat)
(defun org-sec-tag-entry ()
"Adds a :with: property with the value of org-sec-with if
defined, an :at: property with the value of org-sec-where
if defined, and an :on: property with the current time."
(interactive)
(save-excursion
(org-entry-put nil "on" (format-time-string
(org-time-stamp-format 'long)
(current-time)))
(unless (string= org-sec-where "")
(org-entry-put nil "at" org-sec-where))
(if org-sec-with
(org-entry-put nil "with" org-sec-with))))
(global-set-key "\C-cj" 'org-sec-tag-entry)
(defun join (lst sep &optional pre post)
(mapconcat (function (lambda (x) (concat pre x post))) lst sep))
(defun org-sec-get-with ()
(if org-sec-with
org-sec-with
org-sec-me))
(defun org-sec-with-view (par &optional who)
"Select tasks marked as dowith=who, where who
defaults to the value of org-sec-with."
(org-tags-view '(4) (join (split-string (if who
who
(org-sec-get-with)))
"|" "dowith=\"" "\"")))
(defun org-sec-where-view (par)
"Select tasks marked as doat=org-sec-where."
(org-tags-view '(4) (concat "doat={" org-sec-where "}")))
(defun org-sec-assigned-with-view (par &optional who)
"Select tasks assigned to who, by default org-sec-with."
(org-tags-view '(4)
(concat (join (split-string (if who
who
(org-sec-get-with)))
"|")
"/TASK")))
(defun org-sec-stuck-with-view (par &optional who)
"Select stuck projects assigned to who, by default
org-sec-with."
(let ((org-stuck-projects
`(,(concat "+prj+"
(join (split-string (if who
who
(org-sec-get-with))) "|")
"/-MAYBE-DONE")
("TODO" "TASK") ())))
(org-agenda-list-stuck-projects)))
(defun org-sec-who-view (par)
"Builds agenda for a given user. Queried. "
(let ((who (read-string "Build todo for user/tag: "
"" "" "")))
(org-sec-with-view "TODO dowith" who)
(org-sec-assigned-with-view "TASK with" who)
(org-sec-stuck-with-view "STUCK with" who)))
;; End org secretary
(use-package org-arbeitszeit
:ensure t)
(use-package org-tanglesync
:ensure t)
(use-package citar
:ensure t
:requires citeproc
:custom
(org-cite-insert-processor 'citar)
(org-cite-follow-processor 'citar)
(org-cite-activate-processor 'citar)
(citar-at-point-function 'embark-act)
:bind (("C-c b" . citar-insert-citation)
:map minibuffer-local-map
("M-b" . citar-insert-preset)))
(use-package org-emms
:ensure t)
(use-package orgit
:ensure t)
(use-package org
:mode (("\\.org\\'" . org-mode)
("\\.org_archive\\'" . org-mode))
:init
;; From Jason
(defun clone-and-narrow-org-element ()
(interactive)
(setq current-prefix-arg '(4)) ; C-u
(call-interactively 'clone-indirect-buffer)
(org-narrow-to-element))
(defun org-summary-todo (n-done n-not-done)
"Switch entry to DONE when all subentries are done, to TODO otherwise."
(let (org-log-done org-log-states) ; turn off logging
(org-todo (if (= n-not-done 0) "DONE" "TODO"))))
(defun munyoki/is-task-p ()
"Any task with a todo keyword and no subtask"
(save-restriction
(widen)
(let ((has-subtask)
(subtree-end (save-excursion (org-end-of-subtree t)))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
(save-excursion
(forward-line 1)
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task (not has-subtask)))))
(defun munyoki/is-project-p ()
"Any task with a todo keyword subtask"
(save-restriction
(widen)
(let ((has-subtask)
(subtree-end (save-excursion (org-end-of-subtree t)))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
(save-excursion
(forward-line 1)
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task has-subtask))))
(defun clock-in-to-inprogress (kw)
"Switch a task from NEXT to INPROGRESS when clocking in.
Skips capture tasks, projects, and subprojects.
Switch projects and subprojects from NEXT back to TODO"
(when (not (and (boundp 'org-capture-mode) org-capture-mode))
(cond
((and (member (org-get-todo-state) (list "TODO" "WIP" "ON_HOLD"))
(munyoki/is-task-p))
"IN-PROGRESS")
((and (member (org-get-todo-state) (list "TODO" "WIP" "ON_HOLD"))
(munyoki/is-project-p))
"IN-PROGRESS"))))
(cl-defun my/make/org-capture-template
(shortcut heading &optional (no-todo nil) (description heading) (category heading))
"Quickly produce an org-capture-template.
After adding the result of this function to ‘org-capture-templates’,
we will be able perform a capture with “C-c c ‘shortcut’”
which will have description ‘description’.
It will be added to the tasks file under heading ‘heading’
and be marked with category ‘category’.
‘no-todo’ omits the ‘TODO’ tag from the resulting item; e.g.,
when it's merely an interesting note that needn't be acted upon.
─Probably a bad idea─
Defaults for ‘description’ and ‘category’ are set to the same as
the ‘heading’. Default for ‘no-todo’ is ‘nil’.
"
`(,shortcut ,description entry
(file+headline org-default-notes-file
,(concat heading "")
;; ,(concat heading "\n#+CATEGORY: " category)
)
, (concat "*" (unless no-todo " TODO") " %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n")
:empty-lines 1))
:custom
(org-image-actual-width nil)
(org-export-with-drawers
'(not "NOTES" "LOGBOOK"))
(org-latex-pdf-process
(list "latexmk -f -pdf -interaction=nonstopmode -output-directory=%o %f"))
(org-src-window-setup 'current-window)
(org-tag-alist
'(("algorithm" . ?a) ("guix" . ?G)
("genenetwork" . ?g) ("strathmore" . ?s)
("personal" . ?p)
(:startgroup)
("Blog" . ?b)
(:grouptags)
("life-tips" . ?l) ("life" . ?L)
("how_to" . ?h) ("weekly_reviews" . ?w)
("programming" . ?p)
(:endgroup)))
(org-confirm-babel-evaluate
(lambda (lang body)
(not (member lang '("scheme" "python" "sh" "bash")))))
(org-catch-invisible-edits 'show)
(org-clock-history-length 23)
(org-clock-in-resume t)
(org-journal-dir "/home/munyoki/Self/org/journal/")
(org-clock-in-switch-to-state 'clock-in-to-inprogress)
(org-clock-out-remove-zero-time-clocks t)
(org-clock-out-when-done t)
(org-clock-persist t)
(org-clock-report-include-clocking-task t)
(org-crypt-key "D4F09EB110177E03C28E2FE1F5BBAE1E0392253F")
(org-deadline-warning-days 7)
(org-default-notes-file (concat user-home-directory "Self/org/journal.org"))
(org-ellipsis " ⤵")
(org-fontify-quote-and-verse-blocks t)
(org-fontify-done-headline t)
(org-hide-block-startup t)
(org-imenu-depth 7)
(org-log-done 'note)
(org-log-into-drawer "NOTES")
(org-log-state-notes-insert-after-drawers t)
(org-log-note-clock-out nil)
(org-plantuml-jar-path (expand-file-name (concat user-home-directory ".guix-profile/bin/plantuml")))
(org-return-follows-link nil)
(org-reverse-note-order nil)
;; Reset the org-template expansion system, this is need after upgrading to org 9 for some reason
(org-structure-template-alist (eval (car (get 'org-structure-template-alist 'standard-value))))
(org-special-ctrl-a/e t)
(org-src-preserve-indentation t)
(org-src-tab-acts-natively t)
(org-startup-indented t)
(org-tags-exclude-from-inheritance
(quote ("blog" "prj")))
(org-stuck-projects '("+prj/-MAYBE-DONE"
("TODO" "TASK") ()))
(org-timer-default-timer 45)
(org-use-fast-todo-selection t)
(org-use-speed-commands t)
(org-yank-adjusted-subtrees t)
(org-todo-keywords
(quote ((sequence "TODO(t)" "IN-PROGRESS(s@/!)" "|" "DONE(d/!)")
(sequence "TASK(f)" "|" "DONE(d)" )
(sequence "MAYBE(m)" "|" "CANCELLED(c)")
(sequence "WIP(w@/!)" "ON_HOLD(h@/!)" "|" "CANCELLED(c@/!)"))))
(org-todo-keyword-faces (quote (("TODO" :foreground "DarkOrange" :weight bold)
("MAYBE" :foreground "sea green")
("IN-PROGRESS" :foreground "yellow")
("DONE" :foreground "light sea green")
("WIP" :foreground "brown")
("ON_HOLD" :foreground "grey")
("CANCELLED" :foreground "forest green"))))
(org-capture-templates-contexts
'(("r" ((in-mode . "gnus-summary-mode")
(in-mode . "gnus-article-mode")
(in-mode . "message-mode")))))
(add-hook 'org-after-todo-statistics-hook #'org-summary-todo)
:config
(setq org-capture-templates
`(
,(my/make/org-capture-template "g" "Tasks, Genenetwork")
,(my/make/org-capture-template "s" "Tasks, Strathmore")
,(my/make/org-capture-template "d" "Daily Programmer(Algorithms)")
,(my/make/org-capture-template "x" "Tasks, Guix")
,(my/make/org-capture-template "r" "Research")
,(my/make/org-capture-template "m" "Email")
,(my/make/org-capture-template "e" "Emacs (•̀ᴗ•́)و")
,(my/make/org-capture-template "b" "Blog")
,(my/make/org-capture-template "a" "Arbitrary Reading and Learning")
,(my/make/org-capture-template "p" "Personal Matters")
,(my/make/org-capture-template "i" "Meetings, Interviews or Zoom Calls")
,(my/make/org-capture-template "c" "Chores, Repetitive tasks")
("n" "Note" entry (file (concat user-home-directory "Self/org/notes.org"))
"* %? :NOTE:\n%U\n%a\n" :clock-in t :clock-resume t)))
(add-to-list 'org-capture-templates
'("f" "Elfeed" entry (file "/home/munyoki/Self/org/elfeed.org")
"* %a\n%U" :empty-lines 1))
(add-to-list 'org-capture-templates
'("K" "Book" entry (file "/home/munyoki/Self/org/books.org")
"* %^{TITLE}\n:PROPERTIES:\n:ADDED: %<[%Y-%02m-%02d]>\n:END:%^{AUTHOR}p\n%?" :empty-lines 1))
(org-clock-persistence-insinuate)
(org-babel-do-load-languages
'org-babel-load-languages
'((shell . t)
(emacs-lisp . t)
(lisp . t)
(ditaa . t)
(plantuml . t)
(scheme . t)
(dot . t)
(elm . t)
(haskell . t)
(go .t )
(plantuml . t)
(ruby . t)
(rust . t)
(js . t)
(python . t)
(restclient . t)
(R . t)
(sql . t)
(C . t)))
(set-face-attribute 'org-done nil :strike-through t)
(set-face-attribute
'org-headline-done nil
:strike-through t
:foreground "light gray")
:bind (("C-c C-x n" . clone-and-narrow-org-element)
("C-c l" . org-store-link)
("C-c c" . org-capture) ;; Tasks get a 25 minute count down timer
:map org-mode-map
("s-p" . org-babel-previous-src-block)
("s-n" . org-babel-next-src-block)
("s-e" . org-edit-src-block)
("C-c C-x C-r" . org-clock-report)
:map org-src-mode-map
("s-e" . org-edit-src-block)))
(use-package toc-org
:ensure t
:requires org
:hook
((toc-org-mode . org-mode-hook)))
(use-package ob-async
:ensure t
:requires org)
(use-package ob-elm
:ensure t)
(use-package ob-rust
:ensure t
:requires org)
(use-package ob-go
:ensure t
:requires org)
(use-package ob-restclient
:ensure t
:requires org)
(use-package ox-gemini
:ensure t
:requires org
:config
(eval-after-load "org"
'(require 'ox-gemini nil t)))
(use-package ox-gfm
:ensure t
:requires org
:config
(eval-after-load "org"
'(require 'ox-gfm nil t)))
(use-package ox-hugo
:ensure t
:after ox)
(use-package easy-hugo
:ensure t
:custom
(easy-hugo-basedir (concat user-home-directory "Public/BonfaceKilz/"))
(easy-hugo-url "https://bonfacemunyoki.com")
(easy-hugo-sshdomain "myserver")
(easy-hugo-root "/home/munyoki/bonfacemunyoki.com/")
(easy-hugo-previewtime "300")
:bind (("C-c C-e" . easy-hugo)))
(use-package magit-org-todos
:ensure t
:requires org
:config
(magit-org-todos-autoinsert))
(use-package orgit
:ensure t
:requires org
:init
(require 'orgit))
(use-package epresent :ensure t)
(use-package org-tanglesync
:requires org
:custom
(org-tanglesync-skip-user-check nil)
:bind
(( "C-c M-i" . org-tanglesync-process-buffer-interactive))
( "C-c M-a" . org-tanglesync-process-buffer-automatic))
(use-package munyoki/org-crypt
:requires org-crypt
:init
(org-crypt-use-before-save-magic)
(setenv "GPG_AGENT_INFO" nil))
(setq org-crypt-disable-auto-save 'encrypt)
(use-package org-super-agenda :ensure t)
(org-super-agenda-mode)
(let ((org-super-agenda-groups
'((:auto-category t))))
(org-agenda-list))
(use-package munyoki/org-agenda
:requires org
:init
(setq org-agenda-custom-commands
`(("h" "Work todos" tags-todo
"-personal-doat={.+}-dowith={.+}/!-TASK"
((org-agenda-todo-ignore-scheduled t)))
("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE"
((org-agenda-todo-ignore-scheduled nil)))
("g" "Genenetwork"
((agenda "" ((org-agenda-span 1)
(org-agenda-overriding-header "Genenetwork Tasks")
(org-super-agenda-groups
'((:name "Quick Picks"
:and
(:tag "genenetwork" :effort< "0:45"
:todo ("IN-PROGRESS" "ON_HOLD"
"TODO" "STARTED" "TASK"
"MAYBE" "WIP")))
(:name "Currently Working On:"
:and (:todo "IN-PROGRESS" :tag "genenetwork"))
(:name "Important (#A):"
:and (:todo ("IN-PROGRESS" "ON_HOLD" "TODO" "STARTED" "TASK" "MAYBE" "WIP")
:priority "A"
:tag "genenetwork"))
(:name "Medium (#B):"
:and (:todo ("IN-PROGRESS" "ON_HOLD" "TODO" "STARTED" "TASK" "MAYBE" "WIP")
:priority "B"
:tag "genenetwork"))
(:name "Low Priority (#C):"
:and (:todo ("IN-PROGRESS" "ON_HOLD" "TODO" "STARTED" "TASK" "MAYBE" "WIP")
:priority "C"
:tag "genenetwork"))
(:name "All TODOS:"
:and (:todo ("TODO" "TASK" "MAYBE")
:tag "genenetwork"))
(:name "Held Up:"
:and (:todo "ON_HOLD"
:tag "genenetwork"))
(:discard (:anything t))))))
(org-time-budgets-in-agenda-maybe)))
("A" "Work todos with doat or dowith" tags-todo
"-personal+doat={.+}|dowith={.+}/!-TASK"
((org-agenda-todo-ignore-scheduled nil)))
("j" "TODO dowith and TASK with"
(agenda ""
(org-sec-with-view "TODO dowith")
(org-sec-where-view "TODO doat")
(org-sec-assigned-with-view "TASK with")
(org-sec-stuck-with-view "STUCK with"))
(agenda "" ((org-super-agenda-groups
'((:name "dowith"
:tag ("dowith")
:property "dowith")
(:name "doat"
:tag ("doat")
:property "doat"))))))
("J" "Interactive TODO dowith and TASK with"
((org-sec-who-view "TODO dowith")
(agenda "" ((org-super-agenda-groups
'((:name "dowith"
:tag ("dowith")
:property "dowith")
(:name "doat"
:tag ("doat")
:property "doat")))))))
("b" "Agenda with Time Budgets"
((agenda "" ((org-agenda-sorting-strategy '(habit-down time-up priority-down category-keep user-defined-up))))
(org-time-budgets-in-agenda-maybe)))))
(setq munyoki/org-agenda-review-settings
'((org-agenda-show-all-dates t)
(org-agenda-start-with-log-mode t)
(org-agenda-start-with-clockreport-mode t)
(org-agenda-archives-mode t)
;; I don't care if an entry was archived
(org-agenda-hide-tags-regexp
(concat org-agenda-hide-tags-regexp
"\\|ARCHIVE"))))
(add-to-list 'org-src-lang-modes
'("plantuml" . plantuml))
(add-to-list 'org-agenda-custom-commands
'("c" todo "DONE|ON_HOLD|CANCELLED" nil))
(add-to-list 'org-agenda-custom-commands
'("U" "unscheduled tasks" tags "-SCHEDULED={.+}/!+TODO|+STARTED|+WIP"))
(add-to-list 'org-agenda-custom-commands
'("%" "Appointments" agenda* "Today's appointments"
((org-agenda-span 1)
(org-agenda-max-entries 3))))
(add-to-list 'org-agenda-custom-commands
'("u" alltodo ""
((org-agenda-skip-function
(lambda ()
(org-agenda-skip-entry-if 'scheduled 'deadline 'regexp "\n]+>")))
(org-agenda-overriding-header "Unscheduled TODO entries: "))))
(add-to-list 'org-agenda-custom-commands
'("R" . "Review" ))
(add-to-list 'org-agenda-custom-commands
`("Rw" "Week in review"
agenda ""
;; agenda settings
,(append
munyoki/org-agenda-review-settings
'((org-agenda-span 'week)
(org-agenda-start-on-weekday 0)
(org-agenda-overriding-header "Week in Review"))
) ;; journal.org
("/home/munyoki/Self/org/review/week.html")))
(add-to-list 'org-agenda-custom-commands
`("Rl" "Last Week in review"
agenda ""
;; agenda settings
,(append
munyoki/org-agenda-review-settings
'((org-agenda-span 'week)
(org-agenda-start-on-weekday 0)
(org-agenda-start-day "-7d")
(org-agenda-overriding-header "Last Week in Review:")
(org-super-agenda-groups
'((:name "In-Progress Tasks"
:and (:tag "genenetwork" :todo ("IN-PROGRESS" "DONE" "WIP")))
(:name "Held Tasks"
:and (:tag "genenetwork" :todo ("ON-HOLD" "MAYBE")))
(:name "Unscheduled Tasks"
:and (:tag "genenetwork" :todo ("TODO" "TASK")))
(:name "Cancelled Tasks"
:and (:tag "genenetwork" :todo ("CANCELLED")))
(:discard (:anything t))))))
("/home/munyoki/Self/org/review/lastweek.html")))
(add-to-list 'org-agenda-custom-commands
`("Rd" "Day in review"
agenda ""
;; agenda settings
,(append
munyoki/org-agenda-review-settings
'((org-agenda-span 'day)
(org-agenda-overriding-header "Day in Review"))
)
("/home/munyoki/Self/org/review/day.html")))
(add-to-list 'org-agenda-custom-commands
`("Ry" "Yesterday in review"
agenda ""
;; agenda settings
,(append
munyoki/org-agenda-review-settings
'((org-agenda-span 'day)
(org-agenda-start-day "-1d")
(org-agenda-overriding-header "Yesterday in Review")))
("/home/munyoki/Self/org/review/yesterday.html")))
(add-to-list 'org-agenda-custom-commands
`("Rm" "Month in review"
agenda ""
;; agenda settings
,(append
munyoki/org-agenda-review-settings
'((org-agenda-span 'month)
(org-agenda-start-day "01")
(org-read-date-prefer-future nil)
(org-agenda-overriding-header "Month in Review"))
)
("/home/munyoki/Self/org/review/month.html")))
:custom
(org-agenda-files
'("~/Self/org/archive/2024_blog.org_archive"
"~/Self/org/archive/2024_email.org_archive"
"~/Self/org/archive/2024_genenetwork.org_archive"
"~/Self/org/archive/2024_guix.org_archive"
"~/Self/org/archive/2024_personal.org_archive"
"~/Self/org/archive/2024_reading.org_archive"
"~/Self/org/archive/2024_strathmore.org_archive"
"~/Self/org/journal.org"))
(org-agenda-ndays 7)
(org-agenda-show-all-dates nil)
(org-agenda-skip-deadline-if-done nil)
(org-agenda-skip-scheduled-if-done t)
(org-agenda-start-on-weekday nil)
(org-agenda-compact-blocks nil)
:bind(("C-c a" . org-agenda)))
(use-package org-roam
:ensure t
:requires org
:init
(setq org-roam-v2-ack t)
:custom
(org-roam-directory "/home/munyoki/Self/org-roam")
(org-roam-completion-everywhere t)
(org-roam-dailies-capture-templates
'(("d" "default" entry "* %<%I:%M %p>: %?"
:if-new (file+head "%<%Y-%m-%d>.org" "#+title: %<%Y-%m-%d>\n"))))
:bind (("C-c n l" . org-roam-buffer-toggle)
("C-c n f" . org-roam-node-find)
("C-c n i" . org-roam-node-insert)
:map org-mode-map
("C-M-i" . completion-at-point)
:map org-roam-dailies-map
("Y" . org-roam-dailies-capture-yesterday)
("T" . org-roam-dailies-capture-tomorrow))
:bind-keymap
("C-c n d" . org-roam-dailies-map)
:config
(require 'org-roam-dailies) ;; Ensure the keymap is available
(org-roam-db-autosync-mode))
(require 'ox-beamer)
(unless (boundp 'org-export-latex-classes)
(setq org-export-latex-classes nil))
(add-to-list 'org-latex-classes
'("apa6"
"\\documentclass{apa6}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(add-to-list 'org-latex-classes
'("apa7"
"\\documentclass{apa6}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(add-to-list 'org-export-latex-classes
;; beamer class, for presentations
'("beamer"
"\\documentclass[11pt]{beamer}\n
\\mode<{{{beamermode}}}>\n
\\usetheme{{{{beamertheme}}}}\n
\\usecolortheme{{{{beamercolortheme}}}}\n
\\beamertemplateballitem\n
\\setbeameroption{show notes}
\\usepackage[utf8]{inputenc}\n
\\usepackage[T1]{fontenc}\n
\\usepackage{hyperref}\n
\\usepackage{color}
\\usepackage{listings}
\\lstset{numbers=none,language=[ISO]C++,tabsize=4,
frame=single,
basicstyle=\\small,
showspaces=false,showstringspaces=false,
showtabs=false,
keywordstyle=\\color{blue}\\bfseries,
commentstyle=\\color{red},
}\n
\\usepackage{verbatim}\n
\\institute{{{{beamerinstitute}}}}\n
\\subject{{{{beamersubject}}}}\n"
("\\section{%s}" . "\\section*{%s}")
("\\begin{frame}[fragile]\\frametitle{%s}"
"\\end{frame}"
"\\begin{frame}[fragile]\\frametitle{%s}"
"\\end{frame}")))
;; letter class, for formal letters
(use-package org-edna
:ensure t
:after (org-mode)
:custom
(org-edna-finder-use-cache t)
:config
(org-edna-mode))
(use-package munyoki/ol
:config
(setq org-link-keep-stored-after-insertion nil)
:bind (:map org-mode-map
("C-c l" . org-store-link)
("C-c S-l" . org-toggle-link-display)
("C-c C-S-l" . org-insert-last-stored-link)))
(require 'ol)
(defcustom org-elpher-command 'elpher
"The Emacs command to be used to display a gemini page."
:group 'org-link
:type '(choice (const gemini) (const gopher)))
(defun org-elpher-open (path _)
"Visit the gemini/ gopher page on PATH.
PATH should be a topic that can be thrown at the man command."
(funcall org-elpher-command path))
(defun org-elpher-store-link ()
"Store a link to an elpher page."
(when (memq major-mode '(elpher-mode))
;; This is a elpher page, we do make this link.
(let* ((page (elpher-copy-current-url))
(link (elpher-copy-current-url))
(description page))
(org-link-store-props
:type "elpher"
:link link
:description description))))
(defun org-elpher-get-page-name ()
"Extract the page name from the buffer name."
(if (string-match " \\(\\S-+\\)\\*" (buffer-name))
(match-string 1 (buffer-name))
(error "Cannot create link to this man page")))
(org-link-set-parameters "gemini"
:follow #'org-elpher-open
:store #'org-elpher-store-link)
(org-link-set-parameters "gopher"
:follow #'org-elpher-open
:store #'org-elpher-store-link)
(use-package org-contrib
:ensure t
:init
(require 'ox-extra)
(require 'oc-csl)
(require 'oc-natbib)
(require 'oc-biblatex)
(setq org-cite-export-processors
'((beamer natbib)
(latex biblatex)
(t csl))))
(provide 'setup-org)
;;; setup-org.el ends here(setq auth-sources '("~/authinfo.gpg"))
(setq user-full-name "Munyoki Kilyungi")
(setq user-mail-address "[email protected]")
;; sort by most recent date
(setq gnus-article-sort-functions (quote ((not gnus-article-sort-by-date))))
(setq gnus-thread-sort-functions
'(gnus-thread-sort-by-most-recent-date
(not gnus-thread-sort-by-number)))
; NO 'passive
(setq gnus-use-cache t)
;; {{ press "o" to view all groups
(defun my-gnus-group-list-subscribed-groups ()
"List all subscribed groups with or without un-read messages"
(interactive)
(gnus-group-list-all-groups 5))
(define-key gnus-group-mode-map
;; list all the subscribed groups even they contain zero un-read messages
(kbd "o") 'my-gnus-group-list-subscribed-groups)
;; Threads! I hate reading un-threaded email -- especially mailing
;; lists. This helps a ton!
(setq gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject)
;; More attractive Summary View
;; http://groups.google.com/group/gnu.emacs.gnus/browse_thread/thread/a673a74356e7141f
(when window-system
(setq gnus-sum-thread-tree-indent " ")
(setq gnus-sum-thread-tree-root "") ;; "● ")
(setq gnus-sum-thread-tree-false-root "") ;; "◯ ")
(setq gnus-sum-thread-tree-single-indent "") ;; "◎ ")
(setq gnus-sum-thread-tree-vertical "│")
(setq gnus-sum-thread-tree-leaf-with-other "├─► ")
(setq gnus-sum-thread-tree-single-leaf "╰─► "))
(setq gnus-summary-display-arrow t)
(setq gnus-select-method
'(nnmaildir "Fast Mail"
(directory "/home/munyoki/.mail/fastmail")
(gnus-search-engine
gnus-search-notmuch
(config-file "/home/munyoki/.notmuch-config"))))
(add-to-list 'mm-body-charset-encoding-alist '(utf-8 . base64))
(add-hook 'message-setup-hook #'message-sort-headers)
(add-hook 'message-setup-hook #'mml-secure-message-sign-pgpmime)
(add-hook 'message-mode-hook #'(lambda ()
(progn
(setq-local writegood-mode 1)
(setq-local fill-column 50))))
(setq gnus-search-use-parsed-queries nil)
(setq epa-file-cache-passphrase-for-symmetric-encryption nil)
(setq mm-encrypt-option nil)
(setq mm-sign-option nil)
(setq mml-secure-openpgp-encrypt-to-self t)
(setq mml-secure-openpgp-sign-with-sender t)
(setq mml-secure-smime-encrypt-to-self t)
(setq mml-secure-smime-sign-with-sender t)
(setq epa-file-cache-passphrase-for-symmetric-encryption t)
(setq mail-user-agent 'message-user-agent)
(setq compose-mail-user-agent-warnings nil)
(setq message-mail-user-agent t)
(setq message-confirm-send nil)
(setq message-kill-buffer-on-exit t)
(setq message-wide-reply-confirm-recipients t)
(setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3")
(setq mm-discouraged-alternatives '("text/html" "text/richtext"))
(setq mm-automatic-display (remove "text/html" mm-automatic-display))
(setq smtpmail-queue-mail nil)
(setq message-send-mail-function 'message-send-mail-with-sendmail)
(setq sendmail-program (executable-find "msmtp"))
(setq gnus-ignored-newsgroups "^to\\.\\|^[0-9. ]+\\( \\|$\\)\\|^[\"]\"[#'()]")
(setq mail-specify-envelope-from t)
(setq message-sendmail-envelope-from 'header)
(setq mail-envelope-from 'header)
(setq message-kill-buffer-on-exit t)
(setq gnus-thread-hide-subtree t)
(setq gnus-thread-ignore-subject t)
(setq gc-cons-threshold 3500000)
(defun munyoki/message-insert-citation-line ()
"Insert a simple citation line."
(when message-reply-headers
(insert (mail-header-from message-reply-headers) " anaandika:")
(newline)
(newline)))
(setq message-citation-line-function 'munyoki/message-insert-citation-line)
(eval-after-load 'mailcap
'(progn
(cond
;; on macOS, maybe change mailcap-mime-data?
((eq system-type 'darwin))
;; on Windows, maybe change mailcap-mime-data?
((eq system-type 'windows-nt))
(t
;; Linux, read ~/.mailcap
(mailcap-parse-mailcaps)))))-----BEGIN PGP MESSAGE-----
hQIMA7yEhhvnouawARAAjPS9kkpjdybCsFgoIRyRzsyvNW4oshLF6qC6IgPXyLRZ hjYW5Qsf+ZYD+NcGhBMWLNpudaZmuzjX6/5HHTDVMfd9yVntnN5ZwnaLR7AZA4r6 glSQAj7aWI/sU0HNHQLiccw8yKuBytls0mGKRFxnr1lapug7jAb4BTYYCXV9xS4O f43bNX/UWFHkU9QGmO0KGfQKOFYwJJL+rMSLkLqajIBhhOU5/SkgL3Y3CUzwJk// 1VE7jZapahbFAkkCc+Jf52Ver7ztSXCBvfOgll6Wp6vCKoRkhWZXFyDTrvxurUdV zqceFXUwIyTXNWolofiaq4jtjdi6DBiAxGBeID6lwos8DloQsJ262eAYO3CWPXuT uKjh/pNpnfzYGGkRjpoclo06iHBJjzgf1tts0aSC4ROQ4HZ31KHX/kSjjLDwm79a G8HxFArOd1jiJJgqYYiancphGZQqN2Lqpd7owebpFhg241iPKgHcfNf5yID1pZJh ALSMVO1sejoenLQt3M9BDrYgehu3Kl6LKxf1cXhx9oD3j9W41Uwq+uyXN1C1VN0F 1++araa9pNoF1I3MNdhIwiLA+Qcj0U0+2EOB24RA37BQMlRweYzfFLzFdPR3LsrH fjD1VayRhVWHnHvEeVfv27AfjrZ6bmU6wL96Eu+4R/0CeQ2oxm8BXA0Zy5hhqTLS wBYBn9ty1mMZLKV35CKIR70EF4iwPdw6aGL7ukGoEEVDmCgFwjZ10VUAcAx4geT9 V3jkU6F2o8AmwEFBHdk9VLv2kg4vlz6veyMHILF/5MGspLus2DO37mda/CSujU2p BxABzjzrCzjIaB13IJI9V/GOirmWDMq6wSZ3BkvUGBSrL31aPBqYUxVZy9DDKb4W +sODSUjpdiNG/xcjFzdQN/bYAJKUTvs0+BW6taka9wWxSUia4I0WYJ1rdgifjGtX zU5v9uBkpXBn/apHFbMhkAAlvuA8YQ0/ =Drv/ -----END PGP MESSAGE-----
-----BEGIN PGP MESSAGE-----
hQIMA7yEhhvnouawAQ/+KS0l/pxsAUzPBld/xtsJ9D0YXsz95BZM3emfxkYln0l0 IEdIk337TqGXZ2W7ieis/iOPcdVwpIWq3Wp5VuGXGsLRYZNZcrOJFF+QCRdVmAkc qAQdfbZW9+2E2bL6qO9EYyBCIfb4Bt+buPerua7g3n948PzRLdfDXq7mBbxqgTkD BN1ehEHCRTfS8p0r/UkkolbpYPqajRF7nwTBZi8WpPEEzGGDFcBMdA7NkVkk5678 mVbnGXTJyMDkzZ6Qk2Pf5ZzvmlpTXOOJpReBP0I279ScR8XBQ67ULdCR3KQEOxiG dNAHosahFgK9Fm7w7ioPiK5okxQjCKhe/m3mnb+r/HZGUo0Jfua+z5jOi1inbfOE oRAOx/3tZ3bqFPp+jA+SG80mNI3+S8petIFXE6A6CmscagaGIcKkBEEa+CIsShdL EY0bPJxBgZD38Cnx6+FD7XDwWvBOWfSCbQSsZ2gVUiXg3WQTpdXb2JfH5E0I9g2N u4l7SDyABoyih6aTNocYJLc9DcuQOnpMerP5Qbi/c9RSmJNdSV+UluW+rjvc2LVF 67ohE1ejfuw4KXjo3xI+XoHsb7fHM5tQ9PWMtDlvLzjduKbPeg81QWeVyN+gNech prKLrnh6ehLViHTii7cxKAs57t786PJIQT2W56HDxYRrnwT/V/1ff1ITH2G5WLfS wMoB+WErO46PR0PDfJl6y5ZAEWD26gsoIa+fzF8CjnuRMxEeyIndWIIWCSpAn1XY 6KspuaekYAMIfERfVOaSPrrHX6zrmEfyP/ufoLBefF2nAnevrSuAHA3Mo5qif2Bj WDBRot7FrdiuDcpK0r++1cKr8OWaUPWGvOK3KeNgOkzlCnyE1kXNLGgpkUx/8HwV rIQFRPcz1QYV6vVAMAN2CzGMuqunvvnJn+YZ/9ZuOplfzyBvcqd8CoSJFyHseK69 yx/cBjTCuv51arbfyM5eYY95HOk2B3/MMBwRRp+i9rhBuAymTgkjDHLL2EdgiGJV m5hh6XKIL1Ovfjo7X5Y2PwpohOMS/oKGPqgFpyHK8kJmeA7XyVpedz9Yx3qEStnx P26aMboDK2sfpsB/VEYGdpTO5UyE2XUu3yztoMbhcZWyGGgdX1fM6fn5rQ68MFD8 pzk+0D+mVlEMYcOPBzOBaVHMuV4d3dteEwqSycSBuDUF3yvIR5ws3vH+D1QeNblq PkISzhWrsgVW6dOk =VfaJ -----END PGP MESSAGE-----
;;; mailscripts.el --- utilities for handling mail on Unixes -*- lexical-binding: t; -*-
;; Author: Sean Whitton <[email protected]>
;; Version: 28
;; Package-Requires: (notmuch)
;; Copyright (C) 2018, 2019, 2020, 2022 Sean Whitton
;; This program 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.
;; This program 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 this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The original purpose of this package was to make it easy to use the small
;; mail-handling utilities shipped in Debian's 'mailscripts' package from
;; within Emacs. It now also contains some additional, thematically-related
;; utilities which don't invoke any of those scripts.
;;
;; Entry points you might like to look at if you're new to this package:
;; mailscripts-prepare-patch, notmuch-slurp-debbug,
;; notmuch-extract-{thread,message}-patches{,-to-project}.
;;; Code:
(require 'cl-lib)
(require 'thingatpt)
(require 'vc)
(require 'message)
(eval-when-compile (require 'notmuch))
(defgroup mailscripts nil
"Customisation of functions in the mailscripts package."
:group 'mail)
(defcustom mailscripts-extract-patches-branch-prefix nil
"Prefix for git branches created by functions which extract patch series.
E.g. `email/'."
:type 'string
:group 'mailscripts)
(defcustom mailscripts-detach-head-from-existing-branch nil
"Whether to detach HEAD before applying patches to an existing branch.
This is useful if you want to manually review the result of
applying patches before updating any of your existing branches,
or for quick, ad hoc testing of a patch series.
Note that this does not prevent the creation of new branches."
:type '(choice (const :tag "Always detach" t)
(const :tag "Never detach" nil)
(const :tag "Ask whether to detach" ask))
:group 'mailscripts)
(defcustom mailscripts-project-library 'project
"Which project management library to use to choose from known projects.
Some mailscripts functions allow selecting the repository to
which patches will be applied from the list of projects already
known to Emacs. There is more than one popular library for
maintaining a list of known projects, however, so this variable
must be set to the one you use."
:type '(choice (const :tag "project.el" project)
(const :tag "Projectile" projectile))
:group 'mailscripts)
;;;###autoload
(defun notmuch-slurp-debbug (bug &optional no-open)
"Slurp Debian bug with bug number BUG and open the thread in notmuch.
If NO-OPEN, don't open the thread."
(interactive "sBug number: ")
(require 'notmuch)
(call-process-shell-command (concat "notmuch-slurp-debbug " bug))
(unless no-open
(let* ((search (concat "Bug#" bug))
(thread-id (car (process-lines notmuch-command
"search"
"--output=threads"
"--limit=1"
"--format=text"
"--format-version=4" search))))
(notmuch-search search t thread-id))))
;;;###autoload
(defun notmuch-slurp-debbug-at-point ()
"Slurp Debian bug with bug number at point and open the thread in notmuch."
(interactive)
(save-excursion
;; the bug number might be prefixed with a # or 'Bug#'; try
;; skipping over those to see if there's a number afterwards
(skip-chars-forward "#bBug" (+ 4 (point)))
(notmuch-slurp-debbug (number-to-string (number-at-point)))))
(declare-function notmuch-show-get-subject "notmuch-show")
(declare-function notmuch-refresh-this-buffer "notmuch-lib")
;;;###autoload
(defun notmuch-slurp-this-debbug ()
"When viewing a Debian bug in notmuch, download any missing messages."
(interactive)
(require 'notmuch)
(let ((subject (notmuch-show-get-subject)))
(notmuch-slurp-debbug
(if (string-match "Bug#\\([0-9]+\\):" subject)
(match-string 1 subject)
(read-string "Bug number: ")) t)
(notmuch-refresh-this-buffer)))
;;;###autoload
(defun notmuch-extract-thread-patches (repo branch &optional reroll-count)
"Extract patch series in current thread to branch BRANCH in repo REPO.
The target branch may or may not already exist.
With an optional prefix numeric argument REROLL-COUNT, try to
extract the nth revision of a series. See the --reroll-count
option detailed in mbox-extract-patch(1).
See notmuch-extract-patch(1) manpage for limitations: in
particular, this Emacs Lisp function supports passing only entire
threads to the notmuch-extract-patch(1) command."
;; We could obtain a list of message IDs for a subthread, say, and disjoin
;; them to produce a more specific query to pass to the script. This could
;; help in large threads where the script fails to extract the right thing.
(interactive
"Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): \nP")
(let ((search
(cond
((derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
(mailscripts--gnus-message-id-search t))
((derived-mode-p 'notmuch-show-mode)
;; If `notmuch-show' was called with a notmuch query rather
;; than a thread ID, as `org-notmuch-follow-link' in
;; org-notmuch.el does, then `notmuch-show-thread-id' might
;; be an arbitrary notmuch query instead of a thread ID. We
;; need to wrap such a query in thread:{} before passing it
;; to notmuch-extract-patch(1), or we might not get a whole
;; thread extracted (e.g. if the query is just id:foo)
(if (string= (substring notmuch-show-thread-id 0 7) "thread:")
notmuch-show-thread-id
(concat "thread:{" notmuch-show-thread-id "}")))
(t (user-error "Unsupported major mode"))))
(default-directory (expand-file-name repo)))
(mailscripts--check-out-branch branch)
(shell-command
(if reroll-count
(format "notmuch-extract-patch -v%d %s | git am"
(prefix-numeric-value reroll-count)
(shell-quote-argument search))
(format "notmuch-extract-patch %s | git am"
(shell-quote-argument search)))
"*notmuch-apply-thread-series*")))
;;;###autoload
(define-obsolete-function-alias
'notmuch-extract-thread-patches-projectile
'notmuch-extract-thread-patches-to-project
"mailscripts 0.22")
;;;###autoload
(defun notmuch-extract-thread-patches-to-project ()
"Like `notmuch-extract-thread-patches', but choose repo from known projects."
(interactive)
(mailscripts--project-repo-and-branch
'notmuch-extract-thread-patches
(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))))
(declare-function notmuch-foreach-mime-part "notmuch")
(declare-function notmuch--call-process "notmuch-lib")
(declare-function notmuch-show-get-message-id "notmuch-show")
(declare-function notmuch-show-pipe-message "notmuch-show")
(defvar gnus-article-buffer)
(declare-function article-decode-charset "gnus-art")
(declare-function gnus-article-mime-handles "gnus-art")
(declare-function gnus-summary-show-article "gnus-sum")
;;;###autoload
(defalias 'notmuch-extract-message-patches
#'mailscripts-extract-message-patches)
;;;###autoload
(defun mailscripts-extract-message-patches (repo branch)
"Extract patches attached to current message to branch BRANCH in repo REPO.
If there are no attachments that look like patches, offer to try piping the
whole message.
The target branch may or may not already exist.
Patches are applied using git-am(1), so we only consider
attachments with filenames which look like they were generated by
git-format-patch(1)."
;; See `debbugs-gnu-apply-patch' in debbugs-gnu.el for other ideas about
;; identifying which attachments are the patches to be applied.
;; We could make it a defcustom, so that users can supply their own filters.
(interactive
"Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): ")
(let ((default-directory (expand-file-name repo))
handles raw)
(cond ((derived-mode-p 'gnus-summary-mode 'gnus-article-mode)
(with-current-buffer gnus-article-buffer
(setq handles (mapcar #'cdr (gnus-article-mime-handles))
raw (lambda ()
(gnus-summary-show-article 'raw)
(with-current-buffer gnus-article-buffer
(article-decode-charset)
(buffer-string))))))
((derived-mode-p 'notmuch-show-mode)
(with-current-notmuch-show-message
(notmuch-foreach-mime-part (lambda (handle) (push handle handles))
(mm-dissect-buffer t)))
(setq raw (lambda ()
(let (ret)
(with-current-notmuch-show-message
(setq ret (buffer-string)))
ret))))
(t (user-error "Unsupported major mode")))
(cl-callf2 cl-remove-if-not
(lambda (h)
(and-let*
((filename (cdr (assq 'filename (mm-handle-disposition h)))))
(string-match "\\`v?[0-9]+-.+\\.\\(?:patch\\|diff\\|txt\\)\\'"
filename)))
handles)
(if handles
(cl-loop initially (mailscripts--check-out-branch branch)
for handle in handles do (mm-pipe-part handle "git am"))
;; We ask for confirmation because our code for identifying attached
;; patches, and for finding scissors, is very simple.
(setq raw (funcall raw))
(with-temp-buffer
(insert raw)
(goto-char (point-min))
(let ((scissors (re-search-forward "^-- >8 --\\s-*$" nil t)))
(cl-case (or (and scissors
(yes-or-no-p
(substitute-quotes
"Pipe whole message to `git am --scissors'?"))
'scissors)
(yes-or-no-p
(substitute-quotes
(if scissors "Pipe whole message to `git am'?"
"Could not identify attached patches; pipe whole message to `git am'?"))))
(scissors
(call-process-region nil nil "git" nil nil nil "am" "-c"))
((t) (call-process-region nil nil "git" nil nil nil "am"))))))))
;;;###autoload
(define-obsolete-function-alias
'notmuch-extract-message-patches-projectile
'notmuch-extract-message-patches-to-project
"mailscripts 0.22")
;;;###autoload
(defalias 'notmuch-extract-message-patches-to-project
#'mailscripts-extract-message-patches-to-project)
;;;###autoload
(defun mailscripts-extract-message-patches-to-project ()
"Like `mailscripts-extract-message-patches', but choose repo from known projects."
(interactive)
(mailscripts--project-repo-and-branch 'notmuch-extract-message-patches))
;;;###autoload
(defun mailscripts-prepare-patch ()
"Prepare patches for mailing out in a project- and MUA-specific way.
This is a convenience wrapper command for interactive use only.
Its behaviour is subject to change as we add support for more MUAs, ways to
generate patches, etc.."
(interactive)
(call-interactively
(if (eq (vc-deduce-backend) 'Git)
;; For Git, default to one message per patch, like git-send-email(1).
;; Only use attachments when configured for this project.
;;
;; We presently assume that if patches-as-attachments has been
;; configured for this project, it's unlikely that you'll want to send
;; any messages with --scissors patches. That may not be correct.
(cond
((and (local-variable-p 'vc-prepare-patches-separately)
(not vc-prepare-patches-separately))
#'mailscripts-git-format-patch-attach)
((and (catch 'found
(dolist (buffer (buffer-list))
(when (and (string-search "unsent " (buffer-name buffer))
(with-current-buffer buffer
(derived-mode-p 'mail-mode 'message-mode)))
(throw 'found t))))
(yes-or-no-p "Append -- >8 -- patch to unsent message?"))
#'mailscripts-git-format-patch-append)
(t #'mailscripts-git-format-patch-drafts))
#'vc-prepare-patch)))
;;;###autoload
(defun mailscripts-git-format-patch-attach (args &optional new)
"Compose mail with patches generated by git-format-patch(1) attached.
ARGS is a single string of arguments to git-format-patch(1). If NEW is
non-nil (interactively, with a prefix argument), always start composing a
new message. Otherwise, attach patches to an existing mail composition
buffer. This is useful for sending patches in reply to bug reports, etc..
This command is a Git-specific alternative to `vc-prepare-patch' with nil
`vc-prepare-patches-separately'. It makes it easier to take advantage of
various features of git-format-patch(1), such as reroll counts.
For a command for non-nil `vc-prepare-patches-separately', see
`mailscripts-git-format-patch-drafts'.
See also the interactive wrapper command `mailscripts-prepare-patch'."
(interactive "sgit format-patch \nP")
(let ((temp (make-temp-file "patches" t))
(mml-attach-file-at-the-end t)
patches subject)
(condition-case err
(setq patches (apply #'process-lines "git" "format-patch" "-o" temp
(split-string-and-unquote args))
subject
(if (file-exists-p (car patches))
(with-temp-buffer
(insert-file-contents (car patches))
(message-narrow-to-headers-or-head)
(and-let* ((subject (message-fetch-field "subject")))
(if (cdr patches)
(and (string-match
"^\\[\\(.*PATCH.*?\\)\\(?:\\s-+[0-9]+/[0-9]+\\)?\\]\\s-"
subject)
(format "[%s] " (match-string 1 subject)))
subject)))
(user-error "git-format-patch(1) created no patch files")))
(error (delete-directory temp t)
(signal (car err) (cdr err))))
(compose-mail (mailscripts--gfp-addressee) subject nil (not new) nil nil
`((delete-directory ,temp t)))
(mapc #'mml-attach-file patches)
(when (or (not subject) (cdr patches))
(message-goto-subject))))
;;;###autoload
(defun mailscripts-git-format-patch-drafts (args)
"Import patches generated by git-format-patch(1) to your drafts folder.
ARGS is a single string of arguments to git-format-patch(1).
This command is a Git-specific alternative to `vc-prepare-patch' with non-nil
`vc-prepare-patches-separately'. It makes it easier to take advantage of
various features of git-format-patch(1), such as reroll counts.
For a command for nil `vc-prepare-patches-separately', see
`mailscripts-git-format-patch-attach'.
See also the interactive wrapper command `mailscripts-prepare-patch'."
(interactive "sgit format-patch ")
(let ((args (cons "--thread" (split-string-and-unquote args))))
(when-let ((addressee (mailscripts--gfp-addressee)))
(push (format "--to=%s" addressee) args))
(cl-case mail-user-agent
(gnus-user-agent (mailscripts--gfp-drafts-gnus args))
(notmuch-user-agent (mailscripts--gfp-drafts-notmuch args))
(t (user-error "Unsupported mail-user-agent `%s'" mail-user-agent)))))
(declare-function gnus-summary-header "gnus-score")
(declare-function gnus-summary-goto-article "gnus-sum")
(declare-function gnus-summary-copy-article "gnus-sum")
(declare-function gnus-summary-exit-no-update "gnus-sum")
(declare-function gnus-uu-mark-buffer "gnus-uu")
(declare-function gnus-group-read-group "gnus-group")
(declare-function gnus-group-read-ephemeral-group "gnus-group")
(defun mailscripts--gfp-drafts-gnus (args)
(require 'gnus)
(let* ((temp (make-temp-file "patches"))
(group (concat "nndoc+ephemeral:" temp))
(method `(nndoc ,temp (nndoc-article-type mbox)))
(summary (format "*Summary %s*" group))
message-id)
(unwind-protect
(progn (with-temp-file temp
(unless (zerop (apply #'call-process "git" nil t nil
"format-patch" "--stdout" args))
(user-error "git-format-patch(1) exited non-zero")))
(unless (gnus-alive-p) (gnus-no-server))
(gnus-group-read-ephemeral-group group method)
(setq message-id (gnus-summary-header "message-id"))
(gnus-uu-mark-buffer)
(gnus-summary-copy-article nil "nndraft:drafts"))
(when-let ((buffer (get-buffer summary)))
(with-current-buffer buffer
(gnus-summary-exit-no-update t)))
(delete-file temp))
(gnus-group-read-group t t "nndraft:drafts")
(gnus-summary-goto-article message-id)))
(defun mailscripts--gfp-drafts-notmuch (args)
(require 'notmuch)
(let ((temp (make-temp-file "patches" t))
(insert (cl-list* "insert" (format "--folder=%s" notmuch-draft-folder)
"--create-folder" notmuch-draft-tags)))
(unwind-protect
(mapc (lambda (patch)
(unless (zerop (apply #'call-process "notmuch" patch
"*notmuch-insert output*" nil insert))
(display-buffer "*notmuch-insert output*")
(user-error "notmuch-insert(1) exited non-zero")))
(apply #'process-lines "git" "format-patch" "-o" temp args))
(delete-directory temp t)))
(notmuch-search (format "folder:%s" notmuch-draft-folder)))
(defun mailscripts-git-format-patch-append (args)
"Append a patch generated by git-format-patch(1) to an unsent message.
ARGS is a single string of arguments to git-format-patch(1).
The patch is formatted such that a recipient can use the --scissors option to
git-am(1) to apply the patch; see \"DISCUSSION\" in git-format-patch(1)."
(interactive (list (read-string "git format-patch " "-1 ")))
(let ((dir default-directory))
(compose-mail nil nil nil t)
(save-excursion
(save-restriction
(message-narrow-to-headers-or-head)
(let ((unsent-buffer (current-buffer))
(default-directory dir)
(args (split-string-and-unquote args))
(unsent-from (message-fetch-field "from")))
(widen)
(if (re-search-forward message-signature-separator nil t)
(progn (goto-char (pos-bol))
(push "--no-signature" args))
(goto-char (point-max)))
(if (fboundp 'ensure-empty-lines)
(ensure-empty-lines 1)
;; This is only some of what (ensure-empty-lines 1) does.
(if (bolp)
(unless (save-excursion (goto-char (pos-bol 0)) (eolp))
(newline))
(newline 2)))
(insert "-- >8 --\n")
(with-temp-buffer
(apply #'call-process "git" nil t nil "format-patch" "--stdout"
args)
(when (bobp)
(user-error "git-format-patch(1) produced no output"))
(goto-char (point-min))
(delete-line) ; drop "From $SHA1 $magic_timestamp"
(message-narrow-to-headers-or-head)
(when-let* ((unsent
(and unsent-from
(mail-header-parse-address-lax unsent-from)))
(patch-from (message-fetch-field "from"))
(patch (mail-header-parse-address-lax patch-from)))
(when (equal unsent patch)
(message-remove-header "^From:\\|^Date:" t)))
(widen)
(goto-char (point-max))
(delete-blank-lines)
(append-to-buffer unsent-buffer 1 (point-max))))))))
(defun mailscripts--gfp-addressee ()
"Try to find a recipient for the --to argument to git-format-patch(1)."
(or (and (local-variable-p 'vc-default-patch-addressee)
vc-default-patch-addressee)
(car (process-lines-ignore-status
"git" "config" "--get" "format.to"))
(car (process-lines-ignore-status
"git" "config" "--get" "sendemail.to"))))
(defun mailscripts--check-out-branch (branch)
(if (string= branch "")
(when (and
;; Don't proceed if HEAD is already detached.
(zerop (call-process "git" nil nil nil
"symbolic-ref" "--quiet" "HEAD"))
(or (eq mailscripts-detach-head-from-existing-branch t)
(and (eq mailscripts-detach-head-from-existing-branch 'ask)
(yes-or-no-p "Detach HEAD before applying patches?"))))
(call-process-shell-command "git checkout --detach"))
(call-process-shell-command
(format "git checkout -b %s"
(shell-quote-argument
(if mailscripts-extract-patches-branch-prefix
(concat mailscripts-extract-patches-branch-prefix branch)
branch))))))
(defun mailscripts--gnus-message-id-search (&optional thread)
(format (if thread "thread:{id:%s}" "id:%s")
(string-trim (gnus-summary-header "message-id") "<" ">")))
(defvar projectile-known-projects)
(declare-function project-prompt-project-dir "project")
(declare-function projectile-completing-read "projectile")
(defun mailscripts--project-repo-and-branch (f &rest args)
(let ((repo (cl-case mailscripts-project-library
(project
(require 'project)
(project-prompt-project-dir))
(projectile
(require 'projectile)
(projectile-completing-read
"Select Projectile project: " projectile-known-projects))
(t
(user-error
"Please customize variable `mailscripts-project-library'."))))
(branch (read-from-minibuffer
"Branch name (or leave blank to apply to current HEAD): ")))
(apply f repo branch args)))
(provide 'mailscripts)
;;; mailscripts.el ends here