SOMEDAY Emacs configuration
- State “SOMEDAY” from “HOLD” [2021-05-15 Sat 14:13]
- State “HOLD” from “NEXT” [2020-12-11 Fri 16:43]
No active work before org-mode clears
- State “NEXT” from “NEXT” [2018-09-06 Thu 21:10]
- State “NEXT” from “NEXT” [2018-07-11 Wed 18:17]
- State “NEXT” from “NEXT” [2018-07-09 Mon 21:47]
- State “NEXT” from “NEXT” [2018-01-01 Mon 13:17]
- State “NEXT” from “NEXT” [2017-12-29 Fri 23:14]
This is me
;; Setting this is not only fancy, but actually used
;; for example, by yasnippet when filling elisp file header
(setq user-full-name "Ihor Radchenko")
(setq user-mail-address "yantar92@gmail.com")I am not really doing much programming, but rather use Emacs as knowledge base management tool. Most time, I do not even edit or type things directly, but read through the files. Therefore, the main focus of this setup is org-mode and not as much programming, navigating through text and not as much editing.
The usage of org-mode unfortunately means that the overall performance of Emacs is generally not very good. To improve things a little, I am trying to run things that “freeze” Emacs most terribly either asynchronously or in separate Emacs process. Running in separate process would be terribly slow if I just load my main init.el over and over again as if I open a new instance of emacs interactively. Hence, I design my init.el in the way that it can load faster in batch mode.
This Emacs configuration allows loading Emacs in both interactive and batch modes. It is controlled by special variables, identifying startup mode:
init-flag- normal startup, load all the visual packages and options
org-export-flag- load necessary options for org-export
org-tangle-flag- load necessary options for org-tangle
One important note about this configuration is that I do not use desktop-save-mode. Everything I intend to do is kept in my org files, which are automatically loaded by org agenda command.
(defvar init-flag nil
"Do normal init if not nil.")
(defvar org-export-flag nil
"Set up org export if not nil.")
(defvar org-tangle-flag nil
"Set up org tangle if not nil.")init.el
Init file, which loads this file.
;;(package-initialize)
(setq init-flag t)
(setq comp-deferred-compilation-deny-list '("pdf-cache" "org-protocol"))
;; (setq comp-deferred-compilation 't) ;; enable automatic native-compilation
(load el-file)Emacs server settings
As many others, I run emacs in server mode. Actually, it is an nobrainer considering how long my huge org files are being opened.
Setup environment variables
load .profile instead of manual setting hereEND(setenv "PATH" (concat (getenv "PATH") ":/home/yantar92/.local/bin/"))Ensure one server instance
(when init-flag
(require 'server)
(unless (server-running-p)
(server-start)))Run server silently and ignore file clashes (reddit)
(defun ask-user-about-supersession-threat (args)
"Ignore file clashes.")Do not show large file warnings for anything ≤100Mb. The default 10Mb is too small for many pdfs.
(if init-flag
(setq large-file-warning-threshold (* 100 1024 1024)); 100Mb
(setq large-file-warning-threshold nil))Exit server silently without asking about unsaved buffers.
(add-hook 'kill-emacs-hook (lambda() (save-some-buffers 'save-all-buffers)) 'append)Package management & configuration
Package manager: straight.el
Instead of the default emacs package manager, I use straigt.el.
My initial motivation was mostly the ability to get packages from github directly.
In addition, it would be useful to keep track modify the packages in some better way than advising.
el-patch and take a look at fork+master handling by package.elEND
Straight.el can use watchexec to watch changes in the packages, which is much faster in comparison with default find.
Install watchexec
layman -a chaoslab
emerge -v watchexecFirst, make sure that straight.el can fetch remote URLs from everywhere.
Set up the askpass and cache ssh password.
Use net-misc/ssh-askpass-fullscreen.
(setenv "DISPLAY" ":0.0")
(setenv "SSH_ASKPASS" "ssh-askpass-fullscreen")
(when init-flag
(let ((ssh-auth-sock (shell-command-to-string "ssh-agent | grep SSH_AUTH_SOCK | cut -d= -f2 | cut -d';' -f1"))
(ssh-agent-pid (shell-command-to-string "ssh-agent | grep SSH_AGENT_PID | cut -d= -f2 | cut -d';' -f1")))
(setenv "SSH_AUTH_SOCK" (replace-regexp-in-string "\n" "" ssh-auth-sock))
(setenv "SSH_AGENT_PID" (replace-regexp-in-string "\n" "" ssh-agent-pid))
(shell-command-to-string "ssh-add ~/.ssh/id_rsa")
))And tell straight.el to use file watcher
[2020-10-14 Wed] watchexec appears to consume too much system resources
(setq straight-check-for-modifications
'(find-at-startup find-when-checking))
;; https://github.com/raxod502/radian/blob/develop/emacs/radian.el
;; (if (and (executable-find "watchexec")
;; (executable-find "python3"))
;; (setq straight-check-for-modifications '(watch-files find-when-checking))
;; (setq straight-check-for-modifications
;; '(find-at-startup find-when-checking)))For now, I use develop branch of straight.el
(setq straight-repository-branch "develop")And use default git protocol for git repositories in straight.el
(setq straight-vc-git-default-protocol 'ssh)First, put the bootstrap code (as from straight.el readme)
(eval-and-compile
(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)))Load settings
Prefer loading fresh versions of lisp files
(setq load-prefer-newer t)Setup local load-path for whatever is not handled by straigh.el
(eval-and-compile
(when (file-directory-p "~/.emacs.d/site-lisp/")
(setq load-path (append '("~/.emacs.d/site-lisp/") load-path))
(setq load-path (append (directory-files "~/.emacs.d/site-lisp/" t "^[^.]" t) load-path))))Use-package
Now, I can setup use-package to simplify subsequent package configuration
(eval-and-compile (straight-use-package 'use-package))
;;(setq use-package-always-defer t)
(setq use-package-verbose t)
(use-package diminish :straight t)
(use-package bind-key)
Quick access to use-package docstring
(use-package helm
:if init-flag
:defer t
:config
(use-package boon
:config
(bind-key "h u" #'helm-info-use-package boon-goto-map)))
Early loading of org-mode
Load org to make sure that obsolete built-in org version is not used.
The main org-mode config is provided later.
Also use this idea, to make sure that org-plus-contrib is used any time another packages requires org.
(straight-use-package '(org
:type git :repo "yantar92@git.savannah.gnu.org:/srv/git/emacs/org-mode.git"
:local-repo "~/Git/org-mode"
:fork (:host github :repo "yantar92/org" :branch "feature/org-fold-universal-core")))
(straight-use-package '(org-contrib
:type git :repo "https://git.sr.ht/~bzg/org-contrib"
:local-repo "~/Git/org-contrib"))Working with straight.el
Keeping track of the new changes in packages https://github.com/raxod502/straight.el/issues/354
(setq straight-vc-git-auto-fast-forward nil)Quick hydra menu for straight.el
(eval-after-load 'use-package
(use-package hydra
:if init-flag
:straight t
:after boon
:init (use-package straight-x :demand t)
:bind (:map boon-x-map
("M-p" . hydra-straight-helper/body))
:config
(defhydra hydra-straight-helper (:hint nil)
"
_c_heck all |_f_etch all (download) |_m_erge all |_n_ormalize all |p_u_sh all
_C_heck package |_F_etch package (download) |_M_erge package |_N_ormlize package|p_U_sh package
----------------^^+--------------^^+---------------^^+----------------^^+------------||_q_uit||
_r_ebuild all |_p_ull all |_v_ersions freeze|_w_atcher start |_g_et recipe
_R_ebuild package |_P_ull package |_V_ersions thaw |_W_atcher quit |prun_e_ build"
("c" straight-check-all)
("C" straight-check-package)
("r" straight-rebuild-all)
("R" straight-rebuild-package)
("f" straight-x-fetch-all)
("F" straight-fetch-package)
("p" straight-x-pull-all)
("P" straight-pull-package)
("m" straight-merge-all)
("M" straight-merge-package)
("n" straight-normalize-all)
("N" straight-normalize-package)
("u" straight-push-all)
("U" straight-push-package)
("v" straight-freeze-versions)
("V" straight-thaw-versions)
("w" straight-watcher-start)
("W" straight-watcher-quit)
("g" straight-get-recipe)
("e" straight-prune-build)
("q" nil)))).emacs.d layout
By default, there is no convention about file names and placement in .emacs.d. The result is ultimate mess once one install many different packages. Below, I am trying to organise what I can.
User customisation file
Keep customisation away from init.el in a separate file.
(setq custom-file (concat user-emacs-directory "custom.el"))
(load custom-file)
Community effort to solve the problem: no-littering
(use-package no-littering
:demand t
:straight (no-littering :host github :repo "emacscollective/no-littering"
:local-repo "~/Git/no-littering"))Elisp libraries to be used further
Extra functions for association lists
study functionsEND(use-package asoc
:demand t
:straight (asoc.el :type git :host github :repo "troyp/asoc.el"))Handy hook macros [credit]
(defun nox-unquote (exp)
"Return EXP unquoted."
(declare (pure t) (side-effect-free t))
(while (memq (car-safe exp) '(quote function))
(setq exp (cadr exp)))
exp)
(defun nox-enlist (exp)
"Return EXP wrapped in a list, or as-is if already a list."
(declare (pure t) (side-effect-free t))
(if (listp exp) exp (list exp)))
(defun nox-resolve-hook-forms (hooks)
(declare (pure t) (side-effect-free t))
(cl-loop with quoted-p = (eq (car-safe hooks) 'quote)
for hook in (nox-enlist (nox-unquote hooks))
if (eq (car-safe hook) 'quote)
collect (cadr hook)
else if quoted-p
collect hook
else collect (intern (format "%s-hook" (symbol-name hook)))))
(defmacro add-hook! (&rest args)
"A convenience macro for `add-hook'. Takes, in order:
1. Optional properties :local and/or :append, which will make the hook
buffer-local or append to the list of hooks (respectively),
2. The hooks: either an unquoted major mode, an unquoted list of major-modes,
a quoted hook variable or a quoted list of hook variables. If unquoted, the
hooks will be resolved by appending -hook to each symbol.
3. A function, list of functions, or body forms to be wrapped in a lambda.
Examples:
(add-hook! 'some-mode-hook 'enable-something) (same as `add-hook')
(add-hook! some-mode '(enable-something and-another))
(add-hook! '(one-mode-hook second-mode-hook) 'enable-something)
(add-hook! (one-mode second-mode) 'enable-something)
(add-hook! :append (one-mode second-mode) 'enable-something)
(add-hook! :local (one-mode second-mode) 'enable-something)
(add-hook! (one-mode second-mode) (setq v 5) (setq a 2))
(add-hook! :append :local (one-mode second-mode) (setq v 5) (setq a 2))
Body forms can access the hook's arguments through the let-bound variable `args'."
(declare (indent defun) (debug t))
(let ((hook-fn 'add-hook)
append-p local-p)
(while (keywordp (car args))
(pcase (pop args)
(:append (setq append-p t))
(:local (setq local-p t))
(:remove (setq hook-fn 'remove-hook))))
(let ((hooks (nox-resolve-hook-forms (pop args)))
(funcs (let ((arg (car args)))
(if (memq (car-safe arg) '(quote function))
(if (cdr-safe (cadr arg))
(cadr arg)
(list (cadr arg)))
(list args))))
forms)
(dolist (fn funcs)
(setq fn (if (symbolp fn)
`(function ,fn)
`(lambda (&rest _) ,@args)))
(dolist (hook hooks)
(push (if (eq hook-fn 'remove-hook)
`(remove-hook ',hook ,fn ,local-p)
`(add-hook ',hook ,fn ,append-p ,local-p))
forms)))
`(progn ,@(if append-p (nreverse forms) forms)))))
(defmacro remove-hook! (&rest args)
"Convenience macro for `remove-hook'. Takes the same arguments as `add-hook!'."
(declare (indent defun) (debug t))
`(add-hook! :remove ,@args))
(defmacro setq-hook! (hooks &rest rest)
"Convenience macro for setting buffer-local variables in a hook.
(setq-hook! 'markdown-mode-hook
line-spacing 2
fill-column 80)"
(declare (indent 1))
(unless (= 0 (% (length rest) 2))
(signal 'wrong-number-of-arguments (length rest)))
`(add-hook! ,hooks
,@(let (forms)
(while rest
(let ((var (pop rest))
(val (pop rest)))
(push `(setq-local ,var ,val) forms)))
(nreverse forms))))
(defmacro add-transient-hook! (hook-or-function &rest args)
"Attaches a self-removing function to HOOK-OR-FUNCTION.
HOOK-OR-FUNCTION can be a quoted hook or a sharp-quoted function (which will be
advised).
ARGS can be a function, list of functions, or body forms to be wrapped in a lambda.
When it is a function or a list of functions, they will be called with the hooks args."
(declare (indent 1))
(let ((append (if (eq (car args) :after) (pop args)))
;; NOTE(nox):
;; If args is a function or list of functions, funcs will be a list of functions
;; If args is a list of forms, funcs will be a list containing only the list of forms
(funcs (let ((arg (car args)))
(if (memq (car-safe arg) '(quote function))
(if (cdr-safe (cadr arg))
(cadr arg)
(list (cadr arg)))
(list args))))
(func-name (gensym "nox|transient-hook-")))
`(progn
(fset ',func-name
(lambda (&rest call-args)
,@(cl-loop for fn in funcs
collect (if (symbolp fn)
`(apply #',fn call-args)
`(progn ,@args)))
(cond ((functionp ,hook-or-function) (advice-remove ,hook-or-function #',func-name))
((symbolp ,hook-or-function) (remove-hook ,hook-or-function #',func-name)))
(unintern ',func-name nil)))
(cond ((functionp ,hook-or-function)
(advice-add ,hook-or-function ,(if append :after :before) #',func-name))
((symbolp ,hook-or-function)
(put ',func-name 'permanent-local-hook t)
(add-hook ,hook-or-function #',func-name ,append))))))
(defmacro after! (targets &rest body)
"A smart wrapper around `with-eval-after-load'. Supresses warnings during
compilation. This will no-op on features that have been disabled by the user."
(declare (indent defun) (debug t))
(list (if (or (not (bound-and-true-p byte-compile-current-file))
(dolist (next (nox-enlist targets))
(unless (keywordp next)
(if (symbolp next)
(require next nil :no-error)
(load next :no-message :no-error)))))
#'progn
#'with-no-warnings)
(if (symbolp targets)
`(with-eval-after-load ',targets ,@body)
(pcase (car-safe targets)
((or :or :any)
(macroexp-progn
(cl-loop for next in (cdr targets)
collect `(after! ,next ,@body))))
((or :and :all)
(dolist (next (cdr targets))
(setq body `((after! ,next ,@body))))
(car body))
(_ `(after! (:and ,@targets) ,@body))))))Shut things up
Credit: https://github.com/weirdNox/dotfiles/blob/master/config/.emacs.d/config.org#shut-things-up
(defmacro quiet! (&rest forms)
"Run FORMS without making any output."
`(let ((old-fn (symbol-function 'write-region)))
(cl-letf* ((standard-output (lambda (&rest _)))
((symbol-function 'load-file) (lambda (file) (load file nil t)))
((symbol-function 'message) (lambda (&rest _)))
((symbol-function 'write-region)
(lambda (start end filename &optional append visit lockname mustbenew)
(unless visit (setq visit 'no-message))
(funcall old-fn start end filename append visit lockname mustbenew)))
(inhibit-message t)
(save-silently t))
,@forms)))
(defun nox*shut-up (orig-fn &rest args)
"Generic advisor for silencing noisy functions."
(quiet! (apply orig-fn args)))
(defmacro yant/advice-shut-up (func)
"Advise FUNC symbol suppressing all the messages."
`(define-advice ,func (:around (oldfun &rest args) shut-up)
"Silence messages."
(apply #'nox*shut-up oldfun args)))Hash table library
- Refiled on [2020-05-04 Mon 22:44]
(use-package ht
:straight t)String manipulation library
(use-package s
:demand t
:straight t)Performance
Elisp is not the fastest language in the world. There are various options, which can improve the performance.
Bidirectional text is not something I use frequently (never used up until writing this)
(setq bidi-display-reordering nil)Speed up line movement source
(setq auto-window-vscroll nil)Smart garbage collect. Though I don’t want it in batch mode because it is optimised for interactive use.
[2020-05-29 Fri] Email from Koral: Re: gcmh | Commands invoking garbage-collect directly can hang emacs when non-idle (#6) Reducing help:gcmh-cons-threshold to avoid hangs on undo.
(when init-flag
(use-package gcmh
:straight (gcmh :type git :host gitlab :repo "koral/gcmh" :local-repo "~/Git/gcmh"
:fork (:host gitlab :repo "yantar92/gcmh"))
:demand t
:diminish gcmh-mode
:hook (after-init . gcmh-mode)))And increase GC threshold on top of that (I found emacs spend >25% of time doing GC when just moving around the buffer). In batch mode, increase the threshold to make things faster.
(if init-flag
(setq gc-cons-threshold (* 200 1000 1000))
(setq gc-cons-threshold (* 1 1000 1000 1000)))200Mb: elisp:(progn (forward-line) (insert (message “%d” (* 1000 (/ gc-elapsed gcs-done))))) 47ms
400Mb: elisp:(progn (forward-line) (insert (message “%d” (* 1000 (/ gc-elapsed gcs-done))))) 68ms
800Mb: elisp:(progn (forward-line) (insert (message “%d” (* 1000 (/ gc-elapsed gcs-done))))) 228ms
1600Mb: elisp:(progn (forward-line) (insert (message “%d” (* 1000 (/ gc-elapsed gcs-done))))) 188ms
Do not compact font caches
(setq inhibit-compacting-font-caches t)Try to improve the typing speed. The typing lags after long Emacs session (presumably because of garbage collection, but trying this anyway)
(setq redisplay-skip-fontification-on-input t)Appearance
The configuration here is only for generic appearance of emacs. The major mode-specific configuration is configured later on per-mode basis.
Theme
#modus For a while, I have been using various dark themes for emacs. Later, I found light themes easier for my eyes when it is not dark outside. Since it is not really a good idea to work in darkness regardless of the colour scheme, I ended up using a light theme I prefer.;; (use-package flatui-theme
;; :if init-flag
;; :straight t
;; :demand t
;; :config
;; (load-theme 'flatui t))
(use-package modus-themes
:straight (modus-themes
:host gitlab
:repo "protesilaos/modus-themes")
:if init-flag
:init
(setq modus-themes-bold-constructs nil
modus-themes-region 'accent
modus-themes-headings '((t . rainbow-line-no-bold))
modus-themes-org-blocks nil
modus-themes-completions nil
modus-themes-intense-hl-line t
modus-themes-intense-paren-match t
modus-themes-prompts 'subtle-accented)
(setq modus-themes-operandi-color-overrides '((bg-region . nil)))
:custom-face
(org-block-begin-line ((t :inhert org-block :background ,(face-background 'default))))
;; (org-verbatim ((t :background nil :foreground ,(face-foreground 'modus-themes-special-calm))))
;; (region ((t :background ,(face-background 'modus-themes-special-warm))))
:init
(modus-themes-load-themes)
:config
(modus-themes-load-operandi)
(use-package org :config
(set-face-background 'org-block-begin-line (face-background 'default)))
(set-face-background 'org-block-end-line (face-background 'default))
)For the font, I prefer something that works fine with mixed code and text (e.g. org files). My choice is Source Code Pro. Setting it up as default everywhere.
[2020-03-10 Tue] <<39a84dde-88d1-46e8-86d0-28fb8f72f30c>> Chinese symbols are not covered by Source Code Pro. The result is different character width for Chinese characters. Using Sarasa Gothic hc with slightly larger size for Chinese symbols in order to keep the character width same all the time. Credit: https://www.reddit.com/r/emacs/comments/fgbnfv/is_there_a_fixed_width_font_supporting_multiple/
Also, automatically detecting and setting any missing fonts (this comes before manual settings to avoid overrides)
[2021-01-09 Sat] Does not load
(use-package unicode-fonts
:if init-flag
:straight t
:init
(use-package persistent-soft
:straight t) ;; Speed-up unicode-fonts startup, as suggested in unicode-fonts.el commentary
:config
(unicode-fonts-setup))(when init-flag
(set-face-attribute 'default nil
:height 130
:family "Source Code Pro")
(set-fontset-font "fontset-default" 'chinese-gbk (font-spec :size 15.0 :family "Sarasa Mono hc"))
(set-fontset-font "fontset-default" 'cyrillic-iso8859-5 (font-spec :size 18 :family "source code pro"))
;; (mapc (lambda (char)
;; (set-fontset-font "fontset-default" char (font-spec :size 12.0 :family "Source Code Pro")))
;; '(?λ))
;; (mapc (lambda (char)
;; (set-fontset-font "fontset-default" char (font-spec :size 5.0 :family "Quivira")))
;; '(?⏩ ?⛔))
;; (mapc (lambda (char)
;; (set-fontset-font "fontset-default" char (font-spec :size 10.0 :family "Quivira")))
;; '(?★ ?⌛))
;; (mapc (lambda (char)
;; (set-fontset-font "fontset-default" char (font-spec :size 12.0 :family "Symbola")))
;; '(?🖂 ?🖳 ?🏠 ?🔗 ?🖹))
;; (mapc (lambda (char)
;; (set-fontset-font "fontset-default" char (font-spec :size 8.0 :family "Symbola")))
;; '(?🖹 ?⛕))
)The colour of secondary selection in the theme is the same colour with some symbols in my org-agenda.
Actually, it is probably not the case anymore, but it is used to be so…
The colour I use is below
(when init-flag
(set-face-background 'secondary-selection "#aae59c"))For all-the-icons it is important to install the fonts via elisp:all-the-icons-install-fonts
(use-package all-the-icons
:if init-flag
:straight t
:demand t)Startup appearance
Startup message probably only makes sense for someone who is not yet familiar enough with emacs. Disabling
(when init-flag
(setq inhibit-startup-message t))Frame
General frame appearance configuration.
First, disable unnecessary graphical elements No tool bar, no scroll bar, no menu bar.
(when init-flag
(tool-bar-mode -1)
(scroll-bar-mode -1)
(menu-bar-mode -1))Because of the color scheme I use, the border between windows is not easy to distinguish.
Using window-divider-mode to emphasise it more.
(when init-flag
(setq window-divider-default-places 'right-only
window-divider-default-right-width 1)
(set-face-attribute 'window-divider nil
:foreground (face-foreground 'default))
(window-divider-mode +1))By default, emacs frame height can only be a multiple of line height. This is a little annoying when emacs frame is in maximised state, but yet have a small gap on the bottom. Setting resizing to be exact instead.
Not setting it now because of weird bug when capture frame does not renderEND(when init-flag
(setq frame-resize-pixelwise t))Window
General settings for window appearance
Handling pop-up windows
Pop-up windows in emacs sometimes behave in a strange way. They may unexpectedly occupy a window with useful buffer or split window in unexpected direction. The most bizarre case was when a debug buffer popped-up in a non-active frame once. The frame was in different WM workspace and I was totally confused about what is going on.
shackle package allows setting rules for pop-up windows.
(use-package shackle
:if init-flag
:straight t
:diminish shackle-mode
:config (shackle-mode +1)
:custom
(shackle-rules
'(Make help, info, and back-trace pop-up in separate frame
back-trace buffer with the config below pops-up a new frame every time a step into executionEND;; ("*Help*" :select t :frame t)
;; (helpful-mode :select t :frame t)
;; ("*info*" :select t :frame t :same t)
("*Select Link*" :align 'below)
("*Async shell command*" :ignore t)
;; ("*Backtrace*" :select t :frame t :same t))))Centered text in window
- Refiled on [2019-12-25 Wed 14:15]
auto-fill-mode, so I prefer to limit the buffer width.
Olivetti mode \ narrow window display
This mode is minor-mode thus it should be less intrusive in comparison with Centered window mode
(use-package olivetti
:if init-flag
:straight t
:demand t
:after boon
:hook ((text-mode notmuch-show-mode) . olivetti-mode)
:init
(setq-default olivetti-body-width 110)
(setq olivetti-lighter
(s-concat " "
(propertize (all-the-icons-material "tablet")
'face `((:family "Material Icons")))))
(bind-keys :map boon-x-map ("w" . olivetti-mode)))Window boundaries
- Note taken on [2020-08-20 Thu 18:04]
Does not work without fringe - Refiled on [2019-12-25 Wed 14:15]
(when init-flag
(setq-default indicate-buffer-boundaries 'left))Fringes
Match default face background
(set-face-attribute 'fringe nil
:background (face-background 'default))Buffer
General buffer appearance.
Long lines handling
- State “TODO” from [2018-03-12 Mon 14:24]
Long lines do not look good in text buffers and people often turn on line wrapping.
However, long lines are pretty common in special buffers like in elfeed, notmuch, agenda, etc
Setting line wrapping there makes them look ugly.
Moreover, a need to wrap lines in prog-mode buffers is a sign that the code is not formatted well.
So, I don’t really need line wrapping in most of the major modes.
I am setting line truncation globally and enable line wrapping only for several certain major modes (i.e. org-mode).
If the line wrapping is active, I also want the word wrap to be activated automatically and obey the indentation of the beginning of the line.
(when init-flag
(use-package adaptive-wrap
:straight t
:demand t
:bind ("C-x l" . toggle-truncate-lines)
:config
(diminish 'adaptive-wrap-prefix-mode)
(diminish 'visual-line-mode)
(define-advice toggle-truncate-lines (:after (&optional arg) toggle-adaptive-wrap)
"Always use `adaptive-wrap-prefix-mode' when truncation of lines is disabled."
(setq line-move-visual nil)
(if truncate-lines
(adaptive-wrap-prefix-mode -1)
(adaptive-wrap-prefix-mode +1))))
(setq-default truncate-lines t
word-wrap t
line-move-visual nil))Text in buffers
Coding system
Prefer UTF(set-language-environment "English")
(prefer-coding-system 'utf-8)
(add-to-list 'file-coding-system-alist '("\\.org" utf-8))
Line spacing
This looks nicer. credit: Xah Lee(setq-default line-spacing 0.15)Visual text transformation
Show some text in buffer differently
Page break shown as lines
(use-package page-break-lines
:if init-flag
:straight t
:diminish page-break-lines-mode
:config (global-page-break-lines-mode))Pretty symbols
- State “TODO” from [2018-03-12 Mon 14:26]
- State “HOLD” from [2018-03-04 Sun 17:57]
prog-modes. Add more commentaryEND
(use-package pretty-symbols
:if init-flag
:diminish pretty-symbols-mode
:straight t
:after org
:hook (((prog-mode lisp-interaction-mode org-mode) . pretty-symbols-mode))
:init
(setq pretty-symbol-categories '(relational logical lambda org-specific nil cpp general))
(defun yant/str-to-glyph (str)
"Transform string into glyph, displayed correctly."
(let ((composition nil))
(dolist (char (string-to-list str)
(nreverse (cdr composition)))
(push char composition)
(push '(Br . Bl) composition)
)))
:config
(setq pretty-symbol-patterns (let ((lisps '(emacs-lisp-mode
inferior-lisp-mode
inferior-emacs-lisp-mode
lisp-mode scheme-mode))
(c-like '(c-mode
c++-mode go-mode java-mode js-mode
perl-mode cperl-mode ruby-mode
python-mode inferior-python-mode)))
`(
;; Basic symbols, enabled by default
(?λ lambda "\\<lambda\\>" (,@lisps python-mode inferior-python-mode))
(?ƒ lambda "\\<function\\>" (js-mode))
;; general symbols, which can be applied in most of the modes
;; Relational operators --
;; enable by adding 'relational to `pretty-symbol-categories'
(?≠ relational "\\(!=\\)" (,@c-like org-mode) 1)
(?≠ relational "\\(/=\\)" (,@lisps) 1)
(?≥ relational "\\(>=\\)" (,@c-like ,@lisps) 1)
(?≤ relational "\\(<=\\)" (,@c-like ,@lisps) 1)
;; (?≔ relational "[^=]\\(=\\)" (,@c-like ,@lisps org-mode) 1)
(?≡ relational "\\(==\\)" (,@c-like ,@lisps) 1)
(?↠ cpp ">>" (c++-mode))
(?↞ cpp "<<" (c++-mode))
(?➩ cpp " \\(->\\) " (c++-mode org-mode) 1)
(?⋮ cpp "::" (c++-mode))
(?⏎ cpp "\\<endl\\>" (c++-mode))
(?∞ cpp "\\<INF\\>" (c++-mode))
(?⇰ cpp "\\<return\\>" (c++-mode))
;; (?↹ cpp "\\(\\\\t\\) " (,@c-like ,@lisps org-mode))
;; Logical operators
;; (?∧ logical "&&" (,@c-like org-mode))
;; (?∨ logical "||" (,@c-like org-mode))
(?… nil "\\.\\.\\." (org-mode))
(?— nil " \\(-\\) " (org-mode) 1)
((yant/str-to-glyph "——") nil " \\(--\\) " (org-mode) 1)
(?¬ logical "(\\<\\(not\\)\\>" (,@lisps) 1)
(?∅ nil "\\<nil\\>" (,@lisps))
))))Latex pretty symbols
Move to latexEND(use-package latex-pretty-symbols
:if init-flag
:straight t
:config
(global-prettify-symbols-mode t))Selection
(when init-flag
(custom-set-faces '(secondary-selection ((t (:background "DarkSeaGreen3"))))))Highlight todo keywords in code
(use-package hl-todo
:if init-flag
:straight t
:hook (emacs-lisp-mode . hl-todo-mode)
:config
(setq hl-todo-keyword-faces
'(("TODO" . "#FF0000")
("FIXME" . "#FF0000")
("DEBUG" . "#A020F0")
("GOTCHA" . "#FF4500")
("STUB" . "#1E90FF"))))No ugly button for checkboxes
Credit: rougier/elegant-emacs: A very minimal but elegant emacs (I think)(when init-flag
(setq widget-image-enable nil))Underline at descent position
Credit: rougier/elegant-emacs: A very minimal but elegant emacs (I think) Surprisingly, it looks quite nice(when init-flag
(setq x-underline-at-descent-line t))Info buffers
Add extra fontification
(use-package info-colors
:if init-flag
:straight t
:init
(add-hook 'Info-selection-hook 'info-colors-fontify-node))Header line
Light face for header line.
(use-package faces
:if init-flag
:after boon
:init
(use-package color :demand t)
:config
(set-face-attribute 'header-line nil
:weight 'normal
;; :box ,(face-background 'boon-modeline-spc)
;; :box `(:color ,(color-darken-name (face-background 'default) 10) :line-width 5)
:box `(:color ,(face-background 'default) :line-width 5)
;; :box nil
:foreground (color-darken-name (face-foreground 'mode-line) 20)
:underline (face-foreground 'default)
;; :background ,(face-background 'default)
:background (face-background 'default)
)
(set-face-attribute 'mode-line-inactive nil
:weight 'normal
;; :box ,(face-background 'boon-modeline-spc)
;; :box `(:color ,(color-darken-name (face-background 'default) 10) :line-width 5)
:box `(:color ,(face-background 'default) :line-width 5)
;; :box nil
:foreground (color-darken-name (face-foreground 'mode-line) 20)
:underline (face-foreground 'default)
;; :background ,(face-background 'default)
:background (face-background 'default)
)
(set-face-attribute 'mode-line nil
:weight 'normal
;; :box ,(face-background 'boon-modeline-spc)
;; :box `(:color ,(color-darken-name (face-background 'default) 10) :line-width 5)
:box `(:color ,(face-background 'default) :line-width 5)
;; :box nil
:foreground (color-darken-name (face-foreground 'mode-line) 20)
:underline (face-foreground 'default)
;; :background ,(face-background 'default)
:background (face-background 'default)
)
;; (set-face-attribute 'mode-line nil
;; :box nil
;; :underline (face-foreground 'default)
;; :background (face-background 'default)
;; )
;; (set-face-attribute 'mode-line-inactive nil
;; :box nil
;; :underline (face-foreground 'default)
;; :background (face-background 'default)
;; )
)Use header line from rougier/elegant-emacs: A very minimal but elegant emacs (I think) However, tweak it to follow actual text margins when Olivetti mode is turned on.
(when init-flag
(defun yant/vc-git-current-branch ()
"Get current GIT branch."
(and vc-mode
(cadr (s-match "Git.\\([^ ]+\\)" vc-mode))))
(use-package memoize
:straight t
:demand t
:config
(defmemoize mode-line-render (left right)
(let* ((right-width (length right))
(left-width (length left)))
(let ((str
(concat
(make-string (let ((span (/ (- (window-total-width) (window-width)) 2)))
(if (> span 0) span 0))
?\ )
left
(make-string (let ((span (- (window-width) right-width left-width)))
(if (> span 0) span 0))
?\ )
right
(make-string (let ((span (/ (- (window-total-width) (window-width)) 2)))
(if (> span 0) span 0))
?\ ))))
(if (<= (length str) (window-total-width))
str
(s-truncate (window-total-width)
(concat
(make-string (let ((span (/ (- (window-total-width) (window-width)) 2)))
(if (> span 0) span 0))
?\ )
left
(make-string (let ((span (- (window-width) left-width)))
(if (> span 0) span 0))
?\ )
(make-string (let ((span (/ (- (window-total-width) (window-width)) 2)))
(if (> span 0) span 0))
?\ ))))))))
(setq-default mode-line-format
'((:eval
(mode-line-render
;; Left.
(concat (format-mode-line (all-the-icons-icon-for-mode major-mode :v-adjust 0.04 :height 0.8 :face `((:foreground ,(face-foreground 'default)))))
(when (buffer-narrowed-p) (concat " " (propertize (all-the-icons-faicon "filter" :v-adjust 0.04)
'face `((
:family "file-icons"
:foreground ,(face-background 'region))))))
;; Buffer size.
" "
(format-mode-line "%I")
" "
(case major-mode
('org-agenda-mode (format-mode-line (list " " mode-name " ")))
('notmuch-show-mode (format-mode-line (list " " header-line-name " ")))
('elfeed-search-mode (format-mode-line (list " " (elfeed-search--header) " ")))
(t
(or
(and org-src-mode
(format " %s "
(substitute-command-keys
(if org-src--allow-write-back
"Edit, then exit with `\\[org-edit-src-exit]' or abort with \
`\\[org-edit-src-abort]'"
"Exit with `\\[org-edit-src-exit]' or abort with \
`\\[org-edit-src-abort]'"))))
(format-mode-line (list " %b "
(if (and buffer-file-name (buffer-modified-p))
(propertize "(modified)" 'face `(:inherit header-line))))))))
(if truncate-lines
(propertize (all-the-icons-faicon "arrow-right" :v-adjust 0.04)
'face `((
:family "file-icons"
:foreground ,(face-background 'region)
:height 0.6)))
(propertize (all-the-icons-faicon "level-down" :v-adjust 0.04)
'face `((
:family "Material Icons"
:foreground ,(face-background 'region)
:height 0.8)))))
;;Right
(concat
(let ((branch (yant/vc-git-current-branch)))
(if (not branch)
""
(concat (all-the-icons-faicon "angle-left" :v-adjust 0.00)
" "
(all-the-icons-alltheicon "git" :v-adjust 0.04 :height 0.8)
" "
branch
" "
(all-the-icons-faicon "angle-right" :v-adjust 0.00)
" ")))
(all-the-icons-faicon "angle-left" :v-adjust 0.00)
(format-mode-line minor-mode-alist)
" "
(all-the-icons-faicon "angle-right" :v-adjust 0.00)
" "
(let ((position-string (format-mode-line mode-line-position)))
;; (when (string-match " *L[0-9]+ *" position-string)
;; (setq position-string
;; (replace-match "" nil nil position-string)))
(setq position-string (s-trim position-string))
(setq position-string (replace-regexp-in-string "%" "%%" position-string))
(concat " "
(all-the-icons-faicon "angle-left" :v-adjust 0.00)
" "
position-string
" "
(all-the-icons-faicon "angle-right" :v-adjust 0.00)))
" ")))))
;; (defun yant/force-header-line-format ()
;; "Set `header-line-format' to its default value."
;; (setq header-line-name (format-mode-line header-line-format))
;; (setq header-line-format
;; (default-value 'header-line-format)))
;; (add-hook! (org-src-mode org-capture-mode notmuch-show elfeed-search-mode) #'yant/force-header-line-format)
(setq-default header-line-format '(""))
)Mode icons
Major modes
I use all-the-icons for fancy major-mode icons. It knows good icons for many major modes, but not for all.
Defining some modes below:
(use-package all-the-icons
:init
(add-to-list 'all-the-icons-mode-icon-alist '(elfeed-search-mode all-the-icons-faicon "rss" :v-adjust 0.0 :face all-the-icons-purple))
(add-to-list 'all-the-icons-mode-icon-alist '(helpful-mode all-the-icons-faicon "info" :v-adjust -0.1 :face all-the-icons-purple))
(add-to-list 'all-the-icons-mode-icon-alist '(pdf-view-mode all-the-icons-octicon "file-pdf" :v-adjust 0.0 :face all-the-icons-dred))
(add-to-list 'all-the-icons-mode-icon-alist '(notmuch-search-mode all-the-icons-octicon "mail-read" :v-adjust 0.1 :face all-the-icons-dred))
)Mini-buffer
Eldoc show various info in mini-buffer
(when init-flag
(global-eldoc-mode)
(diminish 'eldoc-mode))Since I wrap the default movement commands into custom functions (see Modal setup), I need to make these custom commands trigger eldoc information update.
(when init-flag
(mapc #'eldoc-add-command '(meta-up meta-up-element meta-down meta-down-element meta-backward meta-backward-element meta-forward meta-forward-element meta-scroll-down meta-scroll-up self-insert-command)))Stack messages in mini-buffer when they appear quickly after each other
- Refiled on [2019-12-23 Mon 11:43]
One problem with this is that resizing the echo area forces emacs to redraw, which makes some functions laggy.
this somehow interferes with eldoc in elispEND(defcustom multi-message-timeout 0.5
"Number of seconds between messages before clearing the accumulated list."
:type 'number
:group 'minibuffer
:version "28.1")
(defcustom multi-message-max 3
"Max size of the list of accumulated messages."
:type 'number
:group 'minibuffer
:version "28.1")
(defun multi-message--ellipsis-p (message)
"Return non nil when MESSAGE ends with ellipsis."
(string-match-p "\\.\\.\\.\\'" message))
(defun multi-message--keystroke-regex-p (message)
"Return non nil when MESSAGE looks like a keystroke echo."
(string-match-p "^[A-Za-z]\\(-[A-Za-z]\\)*-?$" message))
(defun multi-message--keystroke-echo-p (message)
"Return non nil when MESSAGE is a currently entered keystroke."
(string-match-p (key-description (this-command-keys-vector)) message))
(defcustom multi-message-transient-functions '(multi-message--ellipsis-p multi-message--keystroke-echo-p multi-message--keystroke-regex-p)
"List of functions to filter out transient messages that should not be stacked.
Each function is called in sequence with message string as an only argument.
If any of the functions returns non nil, the message is filtered out."
:type 'list
:group 'minibuffer
:version "28.1")
(defvar multi-message-separator "\n")
(defvar multi-message-list nil)
(defun set-multi-message (message)
"Return recent messages as one string to display in the echo area.
Note that this feature works best only when `resize-mini-windows'
is at its default value `grow-only'."
(let ((last-message (car multi-message-list)))
(if (and last-message (equal message (aref last-message 1)))
(progn
(cl-incf (aref last-message 3))
(setf (aref last-message 0) (float-time)))
(when last-message
(cond
((> (float-time) (+ (aref last-message 0) multi-message-timeout))
(setq multi-message-list nil))
((or
;; `message-log-max' was nil, potential clutter.
(aref last-message 2)
(run-hook-with-args-until-success 'multi-message-transient-functions (aref last-message 1)))
(setq multi-message-list (cdr multi-message-list)))))
(push (vector (float-time) message (not message-log-max) 0) multi-message-list)
(when (> (length multi-message-list) multi-message-max)
(setf (nthcdr multi-message-max multi-message-list) nil)))
(mapconcat (lambda (m)
(if (= 1 (aref m 3))
(aref m 1)
(concat (aref m 1) (if (> (aref m 3) 1) (format " (x%d)" (aref m 3)) ""))))
(reverse multi-message-list)
multi-message-separator)
;; (let ((message-display (mapconcat (lambda (m) (aref m 1))
;; (reverse multi-message-list)
;; multi-message-separator))
;; (n-lines (s-count-matches "\n" message-display)))
;; (if (and last-message
;; (equal this-command (aref 3 last-message))
;; (< n-lines multi-message-max))
;; (s-concat message-display (s-repeat (- multi-message-max n-lines) "\n"))
;; message-display))
)
)
(setq set-message-function 'set-multi-message)Cursor
Highlight current line
(when init-flag
(global-hl-line-mode t))Change default cursor colour (just my taste)
(when init-flag
(set-cursor-color "IndianRed"))Do not blink
Blinking does not matter much for me and no blinking is one less timer and hence one more tiny bit of slowing Emacs.
(when init-flag
(blink-cursor-mode 0))Command loop
This section contains customisation relevant to actions associated with running various commands.
Dialogues
- do not use graphical dialogues
(setq use-dialog-box nil)
Minibuffer
Do not transfer minibuffer between frames
(setq minibuffer-follows-selected-frame nil)Tooltips
Disable tooltips(tooltip-mode -1)Key bindings
At some point, a got very annoyed about distance between C-n, C-p, C-f, and C-b and did not want to move my hand all the way to arrow keys.
So, I use modal editing now, which allows me to move around using the keys, which are close to each other.
Modal setup
Do not use self-insert-command by default, but bind character keys to navigation, selection, etc.
I use boon package for this purpose.
It is bad idea to enable boon insert mode in special buffers, so it has special mode with limited redefined key binding by default.
This mode replaces normal insert mode.
I add extra functionality for the case when special mode or command mode should not be enabled by default — the buffer requires a lot of writing (I mean shell buffers, for example).
This is defined by boon-insert-state-major-mode-list where the default mode is insert mode.
boon-special-mode is frequently useful in all kinds of major modes, like debug, org-agenda, notmuch, etc.
However, many major modes use the conventional movement key bindings or their derivatives (like “n” and “p” in org-agenda).
I do not like it.
I prefer to have some minimal set of movement keys working in all the buffers (see below).
It means that I need to redefine the movement commands to be able to act according to the major mode (like “n” from org-mode is bound to org-next-line and, hence, “j” from org-special-map should be also bound to org-next-line.
This can be done by defining special wrapper command, which acts differently depending on the mode or buffer position, while the general result or running the command is similar (i.e. move next line in text buffer, but move next file in dired, or next agenda item in org-agenda.
Second, implement the wrapper command <<meta-functions>>. And use the wrapper command in interactive mode.
(use-package meta-functions
:straight (meta-functions :local-repo "~/Git/meta-functions")
:if init-flag
:demand t)Define the most basic movement commands:
- occur
- interactive search in buffer
- goto
- interactive go to a place in buffer
- down/up
- move down/up the line
- down-element/up-element
- move down/up to the next multi-line buffer element
- forward/backward
- move forward/backward by smallest possible element in the buffer
- forward-element/backward-element
- move forward/backward by second smallest element in the buffer
- forward-sexp/backward-sexp
- move forward/backward by an element, which typically takes less then a single line
(use-package meta-functions
:if init-flag
:config
(use-package helm-occur
:defer t
:config
(meta-defun meta-occur "Occur." helm-occur))
(use-package boon
:defer t
:config
(meta-defun meta-new-line "Insert new line." boon-newline-dwim))
(meta-defun meta-undo "Undo." undo)
(meta-defun meta-scroll-up "Scroll up." scroll-up)
(meta-defun meta-scroll-down "Scroll down." scroll-down)
(meta-defun-mapc
'((meta-down "Move down." next-logical-line)
(meta-up "Move up." previous-logical-line)
(meta-end-of-line "Move to the end of line."
(boon-end-of-line)
:mode org-agenda-mode
org-agenda-end-of-line)
(meta-down-element "Move down one element." forward-paragraph)
(meta-up-element "Move up one element." backward-paragraph)
(meta-forward "Move forward." forward-char)
(meta-forward-sexp "Move forward sexp." forward-sexp)
(meta-backward "Move backward." backward-char)
(meta-backward-sexp "Move backward sexp." backward-sexp)
(meta-forward-element "Move forward one element." forward-word)
(meta-backward-element "Move backward one element." backward-word)
(meta-split "Split element at point." split-line)
(meta-recenter-top-bottom "Recenter text on scree." recenter-top-bottom)
(meta-insert-enclosure-new-line "Insert beg/end passive structure in the line below." ignore)
(meta-insert-active-enclosure-new-line "Isert beg/end active structure in the line below." ignore)
))
)It should be noted that the same can be done via setting the proper bindings for “j”, “k”, etc. in the mode itself.
The problem is that it may mess up the cases when I want to assign special meanings to some keys in command-mode, but leave the normal editing on in the insert-mode.
(use-package boon
:if init-flag
:demand t
:straight (boon :type git :host github :repo "jyp/boon" :local-repo "~/Git/boon"
:fork (:host github
:repo "yantar92/boon"))
:diminish boon-local-mode
:config
(setq boon-special-mode-list
'( debugger-mode edebug-mode ediff-mode org-agenda-mode cfw:calendar-mode
eww-mode bm-show-mode
notmuch-search-mode notmuch-show-mode elfeed-search-mode
notmuch-tree-mode elfeed-show-mode pomidor-mode mingus-mode
notmuch-hello-mode ledger-report-mode help-mode
dired-mode image-dired-thumbnail-mode image-dired-display-image-mode
pdf-view-mode helpful-mode magit-file-mode
magit-status-mode magit-revision-mode magit-log-mode
magit-cherry-mode
magit-diff-mode magit-repolist-mode magit-reflog-mode timer-list-mode
org-lint--report-mode image-mode
mingus-playlist-mode mingus-browse-mode
mingus-help-mode calendar-mode undo-tree-visualizer-mode
profiler-report-mode fundamental-mode explain-pause-mode
bm-show-mode font-lock-studio-mode
Info-mode woman-mode Man-mode
eaf-mode image-mode))
(defvar boon-insert-state-major-mode-list '()
"List of major modes started with insert state active.")
(setq boon-insert-state-major-mode-list '( ediff-mode notmuch-message-mode eshell-mode
shell-mode calc-mode
term-mode vterm-mode
magit-popup-mode))
(use-package org
:defer t
:config
(add-hook! 'org-log-buffer-setup-hook (boon-set-state 'boon-insert-state)))
(add-hook 'boon-local-mode-hook
(lambda() (when (and boon-local-mode
(member major-mode boon-insert-state-major-mode-list))
(boon-set-state 'boon-insert-state)))
'append)
(defun boon-set-insert-state ()
"Switch to insert state."
(boon-set-state 'boon-insert-state))
(use-package boon-qwerty)
(boon-mode))Also, I do not like default implementation of boon-special-mode-p, which forces setting special mode for terminal-modes. I prefer to rewrite it
(use-package boon
:if init-flag
:config
(define-advice boon-special-mode-p (:around (oldfun) force-special-mode-list-only)
"Force setting boon-special-mode when mode is in `boon-special-mode-list' and only in it. No exceptions."
(memq major-mode boon-special-mode-list)))Hydra
Hydra is useful to quickly run commands in special contexts. It can be treated as a combination of command mode inboon to get simple key bindings in context with which-key to remind the meanings of these bindings.
Additionally, it is possible to build hydras dynamically.
I currently do not use hydras often.
(use-package hydra
:if init-flag
:straight t)Ignore some system keybindings, which are used in my WM (annoying unknown keybinding error)
(when init-flag
(global-set-key (kbd "<XF86MonBrightnessUp>") #'ignore)
(global-set-key (kbd "<XF86MonBrightnessDown>") #'ignore)
(global-set-key (kbd "S-_") #'ignore)
(global-set-key (kbd "S-)") #'ignore)
(global-set-key (kbd "S-I") #'ignore)
(global-set-key (kbd "S-y") #'ignore)
(global-set-key (kbd "S-u") #'ignore)
(global-set-key (kbd "S-w") #'ignore)
(global-set-key (kbd "C-s-g") #'ignore)
(global-set-key (kbd "C-S-g") #'ignore))Disable terminal key aliases (I don’t use console emacs anyway)
Source: https://www.reddit.com/r/emacs/comments/auwzjr/weekly_tipstricketc_thread/ehcg919/
(when init-flag
;; free up blocked keys (GUI only)
;; add to your init.el
(define-key input-decode-map [?\C-m] [C-m])
(define-key input-decode-map [?\C-i] [C-i])
(define-key input-decode-map (kbd "C-[") [C-\[]))Disable some keybinding, which interfere with my setup (easy to press by mistake)
(when init-flag
(unbind-key "M-u" global-map)
(unbind-key "M-k" global-map)
(unbind-key "M-j" global-map)
(unbind-key "M-." global-map))Quitting minibuffer when point is in another window
Credit: [[id:clemera2020_with_emacs_quit_curren_contex][clemera [with-emacs] (2020) With-Emacs · Quit Current Context]]
(defun keyboard-quit-context+ ()
"Quit current context.
This function is a combination of `keyboard-quit' and
`keyboard-escape-quit' with some parts omitted and some custom
behavior added."
(interactive)
(cond ((region-active-p)
;; Avoid adding the region to the window selection.
(setq saved-region-selection nil)
(let (select-active-regions)
(deactivate-mark)))
((eq last-command 'mode-exited) nil)
(current-prefix-arg
nil)
(defining-kbd-macro
(message
(substitute-command-keys
"Quit is ignored during macro defintion, use \\[kmacro-end-macro] if you want to stop macro definition"))
(cancel-kbd-macro-events))
((active-minibuffer-window)
(when (get-buffer-window "*Completions*")
;; hide completions first so point stays in active window when
;; outside the minibuffer
(minibuffer-hide-completions))
(abort-recursive-edit))
(t
;; if we got this far just use the default so we don't miss
;; any upstream changes
(keyboard-quit))))
(global-set-key [remap keyboard-quit] #'keyboard-quit-context+)Make key bindings work in Ukrainian/Russian keymap
(use-package reverse-im
:straight t
:if init-flag
:config
(reverse-im-activate "russian-computer"))
(when init-flag
(cl-loop
for from across "йцукенгшщзхїфівапролджєячсмитьбюЙЦУКЕНГШЩЗХЇФІВАПРОЛДЖЄЯЧСМИТЬБЮ№"
for to across "qwertyuiop[]asdfghjkl;'zxcvbnm,.QWERTYUIOP{}ASDFGHJKL:\"ZXCVBNM<>#"
do
(eval `(define-key local-function-key-map
(kbd ,(concat "C-"
(string from)))
(kbd ,(concat "C-"
(string to)))))
(eval `(define-key local-function-key-map
(kbd ,(concat "M-"
(string from)))
(kbd ,(concat "M-"
(string to)))))
(eval `(define-key local-function-key-map
(kbd ,(concat "C-M-"
(string from)))
(kbd ,(concat "C-M-"
(string to)))))
(eval `(define-key local-function-key-map
(kbd ,(string from))
(kbd ,(string to))))))Mnemonic key binding for exit-recursive-edit
(when init-flag
(bind-key* "C-S-g" #'exit-recursive-edit))Chinese input
(use-package pyim
:if init-flag
:straight t
:demand t
:config
(setq default-input-method "pyim")
(setq-default pyim-english-input-switch-functions
'(pyim-probe-isearch-mode
pyim-probe-program-mode
pyim-probe-org-structure-template))
(setq pyim-page-length 5))Default major mode
Use text-mode by default. From https://github.com/cadadr/configuration/blob/master/emacs.d/init.el
;; Default mode is ‘text-mode’. The actual default,
;; ‘fundamental-mode’ is rather useless.
(setq-default major-mode 'text-mode)Completion
Completion is what makes working in Emacs look like magic.
Helm
The update is delayed terribly sometimes. Not sure why. Sometimes, the helm buffer does not get updated at all, especially on short input (1-2 chars)ENDUnlike default completion, helm lets you see all the possible completions dynamically updated as you type.
No need to press TAB like crazy.
In addition to Emacs-wide change of the completion method, Helm also provides a bunch of useful commands, which especially benefit from live completion:
M-xcompletion does not require the user to remember exact command names and exact sequence of words in command names- apropos commands become a lot easier to discover
- can search in kill ring
- can search in most of info pages, including Emacs manual
Helm mode is very special in regards to boon because it works in mini-buffer.
Hence, I had to define special versions of boon-like bindings for helm.
The basic idea is to prefix movement commands with meta.
(use-package helm
:if init-flag
:straight (helm :type git :host github :repo "emacs-helm/helm" :local-repo "~/Git/helm"
:fork (:host github
:repo "yantar92/helm"))
:diminish helm-mode
:requires boon
:after boon
:init
;; Re-define obsolete variables removed in latest Emacs
(defvar minibuffer-local-must-match-filename-map nil)
(defvar browse-url-mosaic-program nil)
:bind (
("M-x" . helm-M-x)
("M-y" . helm-show-kill-ring)
("<f1> a" . helm-apropos)
("<f1> b" . helm-descbindings)
;; ("C-x 8 <RET>" . helm-ucs)
("C-x c" . nil)
:map helm-map
("M-j" . helm-next-line)
("M-k" . helm-previous-line)
("M-o" . helm-next-source)
("M-i" . helm-previous-source)
("M-l" . yant/helm-yank-selection-or-execute-persistent-action)
("C-u" . helm-execute-persistent-action)
("C-M-h" . backward-kill-word)
("M-h" . backward-kill-word)
("C-h" . backward-delete-char-untabify)
:map helm-find-files-map
("M-l" . helm-execute-persistent-action)
:map boon-goto-map
("e" . helm-resume)
)
:defines helm-global-mode
:custom
(helm-split-window-inside-p t)
(helm-move-to-line-cycle-in-source t)
(helm-ff-file-name-history-use-recentf t)
(helm-mode-fuzzy-match t)
:config
(defun yant/helm-yank-selection-or-execute-persistent-action (arg)
"Call `helm-yank-selection' in some cases listed below."
(interactive "P")
(pcase helm--prompt
((pred (string-match-p "Refile\\|\\(Link to attachment from\\)")) (funcall-interactively #'helm-yank-selection arg))
(_ (funcall-interactively #'helm-execute-persistent-action))))
(helm-mode 1))Adaptive sorting of candidates
It is handly when frequently used matches are shown on top. Credit: emacs-tv-config/init-helm.el at master · thierryvolpiatto/emacs-tv-config
(use-package helm-adaptive
:if init-flag
:after helm
:config
(setq helm-adaptive-history-file nil)
(helm-adaptive-mode 1))Icons helm-icons
(use-package helm-icons
:straight t
:if init-flag
:after helm
:custom
(helm-icons-provider 'all-the-icons)
(helm-icons-mode->icon
'((dired-mode . "file-directory")))
:config
(helm-icons-enable))Company
- State “CANCELLED” from [2017-09-22 Fri 07:58]
Context completion is very useful, especially if a major mode supports the completion. I use company for completion just because it is easy to use.
(use-package company
:if init-flag
:straight t
:diminish (company-mode . " ⭿")
:hook ((prog-mode ledger-mode) . company-mode)
:custom
(company-idle-delay 0.05)
(company-minimum-prefix-length 2)
(company-selection-wrap-around t)
(company-require-match nil)
(company-transformers '(company-sort-by-occurrence))
:config
(bind-key* "M-/" #'company-complete)
:bind (:map company-active-map
("<tab>" . nil)
("M-j" . company-select-next)
("M-k" . company-select-previous)
("C-h" . backward-delete-char-untabify)
("C-M-h" . backward-kill-word)
("M-l" . nil)
("M-h" . company-show-doc-buffer)
("M-s" . company-filter-candidates)))Skeleton
- State “TODO” from [2018-10-21 Sun 14:28]
Skeletons go beyond simple completion of a single word. They define a powerful template system making completion programmable and interactive.
History & version control
Keeping history of file changes both in short and long term is just like backups. One is already using it or not yet using…
Save buffer key binding
Boon command mode allows translating c 'symbol key bindings into C-c
'symbol key bindings. It is useful, but save-buffer is more meaningful
to rebind to C-c s is such a case and save-some-buffers to C-c C-s.
(use-package boon
:if init-flag
:defer t
:config
(bind-key "C-x s" 'save-buffer)
(bind-key "C-x C-s" 'save-some-buffers))Backup
I don’t like Emacs’ default behaviour to save backup files in the same folder, thus cluttering it annoyingly. Keep everything in a single folder with tree (credit: Xah Lee) structure.
;; make backup to a designated dir, mirroring the full path
(defun my-backup-file-name (fpath)
"Return a new file path of a given file path.
If the new path's directories does not exist, create them."
(let* (
(backupRootDir (cdar backup-directory-alist))
(filePath (replace-regexp-in-string "[A-Za-z]:" "" fpath )) ; remove Windows driver letter in path, for example, “C:”
(backupFilePath (replace-regexp-in-string "//" "/" (concat backupRootDir filePath "~") ))
)
(make-directory (file-name-directory backupFilePath) (file-name-directory backupFilePath))
backupFilePath))
(setq make-backup-file-name-function 'my-backup-file-name)
(setq
backup-by-copying t
delete-old-versions t
kept-new-versions 100
kept-old-versions 100
version-control t
)Since this config is often called in extra batch process, lock-files can mess everything up. Disable them.
(setq create-lockfiles nil)Backup walker
Walk across the backup files
(use-package backup-walker
:if init-flag
:straight t
:commands backup-walker-start)Auto save
(use-package no-littering
:demand t
:config
(setq auto-save-file-name-transforms `((".*" ,(no-littering-expand-var-file-name "auto-save/") t))
auto-save-interval 20))Save virtual buffers (kill ring, etc.)
(when init-flag
(savehist-mode 1))Persistent scratch
(use-package persistent-scratch
:if init-flag
:straight t
:demand t
:config
(persistent-scratch-autosave-mode 1))Recent files
Show recently opened files in helm-mini buffer.
(use-package helm
:if init-flag
:defer t
:config
(recentf-mode t)
(setq
recentf-max-menu-items 30
recentf-max-saved-items 100
helm-ff-file-name-history-use-recentf t))No global auto-revert
Auto-revert mode is nice, but it slows down Emacs on my huge .org files. Hence, I do not use it globally, but enable only where I need it.
(global-auto-revert-mode -1)
(diminish 'auto-revert-mode)
(setq auto-revert-verbose nil)
(setq revert-without-query '(".*"))
(bind-key* "M-r" #'revert-buffer)Follow symlinks to vc files
(setq vc-follow-symlinks t)Magit
One more step towards doing all the things in Emacs. Do not even need terminal to interact with Git.
(use-package magit
:straight t
:if init-flag
:after boon
:requires boon
:init
(use-package unpackaged
:init (use-package ts :straight t)
:straight (unpackaged :host github :repo "alphapapa/unpackaged.el")
:demand t)
:bind (:map boon-x-map
("g" . unpackaged/magit-status)
("G" . magit-dispatch-popup)
("M-g" . magit-file-popup))
:config
(unpackaged/magit-log-date-headers-mode +1)
;; Remove added hook
(ignore-errors
(setq magit-diff-visit-file (-remove-last magit-diff-visit-file)))
(use-package meta-functions
:config
(meta-defun meta-down-element :mode magit-diff-mode magit-section-forward)
(meta-defun meta-up-element :mode magit-diff-mode magit-section-backward)
(meta-defun meta-down-element :mode magit-status-mode magit-section-forward)
(meta-defun meta-up-element :mode magit-status-mode magit-section-backward)
(meta-defun meta-down-element :mode magit-revision-mode magit-section-forward)
(meta-defun meta-up-element :mode magit-revision-mode magit-section-backward)))Interaction with Github
(use-package forge
:if init-flag
:straight t
:after magit
:custom
(forge-owned-accounts '(("yantar92"))))Activate insert state when editing commits
(when init-flag
(add-hook 'with-editor-mode-hook #'boon-set-insert-state))Initial section visibility
Credit: Irreal: Setting the Initial Visibility of Magit Sections(use-package magit
:after magit
:custom
(magit-section-initial-visibility-alist
'((stashes . hide) (untracked . hide) (unpushed . hide))))More detailed highlight of current chunk
Magit is able to provide word-level diff refinement. It is disabled by default though. Enabling.
(use-package magit
:requires diff-mode
:custom
(magit-diff-refine-hunk t)
:custom-face
(diff-refine-removed ((t
:inherit diff-refine-changed
:background "Palevioletred1")))
(diff-refine-added ((t
:inherit diff-refine-changed
:background "LightGreen"))))Working with multiple repositories
(use-package magit
:if init-flag
:after magit
:commands magit-list-repositories
:custom
(magit-repository-directories '(("~/Git" . 1)
("~/Org" . 0)))
(magit-repolist-columns '(("Name" 25 magit-repolist-column-ident nil)
;; ("Version" 25 magit-repolist-column-version nil)
("Branch" 25 magit-repolist-column-branch nil)
("B<U" 3 magit-repolist-column-unpulled-from-upstream
((:right-align t)
(:help-echo "Upstream changes not in branch")))
("B>U" 3 magit-repolist-column-unpushed-to-upstream
((:right-align t)
(:help-echo "Local changes not in upstream")))
("Path" 99 magit-repolist-column-path nil))))Opening repository file in remote browse-at-remote
(use-package browse-at-remote
:if init-flag
:straight t
:config
(bind-key "C-c M-o" #'browse-at-remote))Ediff
Inspired by [[id:f69a49e2e7f32a4854d049826353240659f965ff][/u/freesteph [Reddit:emacs] (2021) M-x emacs-reddit: How do you solve merge conflicts?]]
(use-package ediff
:if init-flag
:config
(setq ediff-diff-options "")
(setq ediff-custom-diff-options "-u")
(setq ediff-split-window-function 'split-window-vertically))Text highlight & colouring
Temporary highlight text in buffer
User-defined temporary highlighting.
(use-package hi-lock
:if init-flag
:diminish hi-lock-mode)Spell\grammar checking
- State “TODO” from [2018-07-18 Wed 11:26]
Typos are inevitable. Highlighting typos is crucial.
Flyspell
fly ispell only with idle timer?ENDenable in org-modeEND
(use-package flyspell
:if init-flag
:straight t
:after org
:diminish (flyspell-mode . " ✓")
:hook ((notmuch-message-mode org-mode) . flyspell-mode)
:bind (("<f8>" . ispell-word)
("M-<f8>" . ispell-buffer)
:map boon-forward-search-map
("s" . flyspell-goto-next-error))
:init
(use-package boon)
:config
(setq ispell-program-name "/usr/bin/ispell-aspell")
(setq ispell-dictionary "british")
(use-package no-littering
:demand t
:config
(setq ispell-personal-dictionary "~/.emacs.d/etc/ispell-personal-dictionary.txt")))Textual error pop-up
(use-package flyspell
:if init-flag
:config
(defun flyspell-emacs-popup-textual (event poss word)
"A textual flyspell popup menu.
From https://www.emacswiki.org/emacs/FlySpell"
(require 'popup)
(let* ((corrects (if flyspell-sort-corrections
(sort (car (cdr (cdr poss))) 'string<)
(car (cdr (cdr poss)))))
(cor-menu (if (consp corrects)
(mapcar (lambda (correct)
(list correct correct))
corrects)
'()))
(affix (car (cdr (cdr (cdr poss)))))
show-affix-info
(base-menu (let ((save (if (and (consp affix) show-affix-info)
(list
(list (concat "Save affix: " (car affix))
'save)
'("Accept (session)" session)
'("Accept (buffer)" buffer))
'(("Save word" save)
("Accept (session)" session)
("Accept (buffer)" buffer)))))
(if (consp cor-menu)
(append cor-menu (cons "" save))
save)))
(menu (mapcar
(lambda (arg) (if (consp arg) (car arg) arg))
base-menu)))
(cadr (assoc (popup-menu* menu :scroll-bar t) base-menu))))
(fset 'flyspell-emacs-popup 'flyspell-emacs-popup-textual)
(defadvice flyspell-goto-next-error (after check-word-spelling activate) (ispell-word))
)Automatically add wrong spelled words to abbrev to avoid such mistakes later
The idea and the code is from here.
(when init-flag
(bind-key* "M-h" #'endless/ispell-word-then-abbrev)
(defun endless/simple-get-word ()
(car-safe (save-excursion (ispell-get-word nil))))
(defun endless/ispell-word-then-abbrev (p)
"Call `ispell-word', then create an abbrev for it.
With prefix P, create local abbrev. Otherwise it will
be global.
If there's nothing wrong with the word at point, keep
looking for a typo until the beginning of buffer. You can
skip typos you don't want to fix with `SPC', and you can
abort completely with `C-g'."
(interactive "P")
(let (bef aft)
(save-excursion
(while (if (setq bef (endless/simple-get-word))
;; Word was corrected or used quit.
(if (ispell-word nil 'quiet)
nil ; End the loop.
;; Also end if we reach `bol'.
(not (bolp)))
;; If there's no word at point, keep looking
;; until `bol'.
(not (bolp)))
(backward-word)
(backward-char))
(setq aft (endless/simple-get-word)))
(if (and aft bef (not (equal aft bef)))
(let ((aft (downcase aft))
(bef (downcase bef)))
(define-abbrev
(if p local-abbrev-table global-abbrev-table)
bef aft)
(message "\"%s\" now expands to \"%s\" %sally"
bef aft (if p "loc" "glob")))
(user-error "No typo at or before point"))))
(setq save-abbrevs 'silently)
(setq-default abbrev-mode t)
(diminish 'abbrev-mode))Speed-up flyspell post-command-hook
I often experience long delays when flyspell is active in org buffers.
Profiling revealed that the possible bottleneck is sit-for in
flyspell-check-word-p, which causes redisplay - redisplay turns out to
be very slow in some cases.
I cannot do much about redisplay, but redisplay does not seem to be necessary for flyspell-check-word-p.
Using patched version suppressing redisplay.
(use-package el-patch
:straight t
:config
(el-patch-feature flyspell)
(el-patch-defun flyspell-check-word-p ()
"Return t when the word at `point' has to be checked.
The answer depends of several criteria.
Mostly we check word delimiters."
(let ((ispell-otherchars (ispell-get-otherchars)))
(cond
((<= (- (point-max) 1) (point-min))
;; The buffer is not filled enough.
nil)
((and (and (> (current-column) 0)
(not (eq (current-column) flyspell-pre-column)))
(save-excursion
(backward-char 1)
(and (looking-at (flyspell-get-not-casechars))
(or (string= "" ispell-otherchars)
(not (looking-at ispell-otherchars)))
(or flyspell-consider-dash-as-word-delimiter-flag
(not (looking-at "-"))))))
;; Yes because we have reached or typed a word delimiter.
t)
((symbolp this-command)
(cond
((get this-command 'flyspell-deplacement)
(not (eq flyspell-previous-command this-command)))
((get this-command 'flyspell-delayed)
;; The current command is not delayed, that
;; is that we must check the word now.
(and (not unread-command-events)
(sit-for flyspell-delay (el-patch-add 'nodisplay))))
(t t)))
(t t)))))Language tool
[[id:dc748ee50c332dec74bd79083898359f7214692f][languagetool-org [Github] languagetool: Style and Grammar Checker for 25+ Languages]]
Run languagetool on region
(use-package langtool
:straight t
:init
(setq langtool-bin "languagetool")
(setq langtool-default-language "en-GB")
(setq langtool-mother-tongue "uk-UA")
(setq langtool-user-arguments "-c UTF8 -b")
(setq langtool-disabled-rules
'(
"DASH_RULE"
;; "WHITESPACE_RULE"
;; "PUNCTUATION_PARAGRAPH_END"
"EN_QUOTES"
))
(defhydra help/hydra/both/langtool (:color blue :hint nil)
"
Langtool:^ ^|^ ^|^
-------------------^^+^-------------------^+^----------------------
_h_: check buffer | _j_: next error | _i_: brief message
_y_: correct buffer | _k_: previous error | _o_: detailed message
_n_: finished | _q_: quit |
"
("h" langtool-check :exit nil)
("y" langtool-correct-buffer :exit nil)
("n" langtool-check-done)
("j" langtool-goto-next-error :exit nil)
("k" langtool-goto-previous-error :exit nil)
("i" langtool-show-brief-message-at-point :exit nil)
("o" langtool-show-message-at-point :exit nil)
("q" nil))
(bind-key "M-s" #'help/hydra/both/langtool/body boon-forward-search-map))
Check grammar in emails before sending
- Note taken on [2021-08-17 Tue 17:58]
Somehow it puts wrong overlays in many messages
(use-package langtool
:if init-flag
:after notmuch
:config
(defun langtool-check-buffer-ensure ()
"Force full check of current buffer. Block Emacs until check is done."
(interactive)
(langtool-check-buffer)
(while langtool-buffer-process
(sleep-for 0.1))
(langtool-correct-buffer))
;; (add-hook! 'notmuch-mua-send-hook #'langtool-check-buffer-ensure)
)Code checking
Show errors in code with flycheck, in tooltips (via flycheck-tip).
I also use shellcheck software to check my bash scripts (it is automatically used by flycheck if available).
Thanks Alvaro Ramirez’s notes: Trying out ShellCheck for suggestion!
(use-package flycheck
:if init-flag
:straight t
:diminish (flycheck-mode . " λ✓")
:hook ((prog-mode lisp-interaction-mode) . flycheck-mode)
:config
(use-package flycheck-tip
:straight t
:config
(setq flycheck-display-errors-function 'ignore)
(use-package boon
:config
(bind-keys :map boon-forward-search-map
("c" . flycheck-tip-cycle)
:map boon-backward-search-map
("c" . flycheck-tip-cycle-reverse)))))Highlight parentheses in code
(use-package highlight-parentheses
:if init-flag
:straight t
:diminish highlight-parentheses-mode
:custom
(highlight-parentheses-background-colors `(,(face-background 'modus-themes-intense-red)
,(face-background 'modus-themes-intense-magenta)
,(face-background 'modus-themes-refine-blue)
))
:config
(add-hook! 'minibuffer-setup-hook #'highlight-parentheses-minibuffer-setup)
(add-hook! (prog-mode
helpful-mode
debugger-mode
lisp-interaction-mode)
#'highlight-parentheses-mode))
(use-package rainbow-delimiters
:if init-flag
:straight t
:hook ((prog-mode lisp-interaction-mode) . rainbow-delimiters-mode))Highlight numbers
(use-package highlight-numbers
:if init-flag
:straight t
:hook ((prog-mode lisp-interaction-mode) . highlight-numbers-mode))Regexp escape smart highlight
Emacs regex escaping in string is often confusing.
easy-escape helps to avoid mistakes.
[[id:Github-cpitclaudel-cpitclaudel-easy-escape-331][cpitclaudel [Github] cpitclaudel/easy-escape: Improve readability of escape characters in ELisp regular expressions]]
(use-package easy-escape
:if init-flag
:straight t
:diminish easy-escape-minor-mode
:hook ((prog-mode lisp-interaction-mode) . easy-escape-minor-mode))Search highlight
Highlight text matching isearch.
(when init-flag
(setf search-highlight t)
(setf query-replace-highlight t))NEXT #goggles Highlight recent changes\actions
- Note taken on [2020-12-10 Thu 10:04]
Fix errors in pull request
Highlight recently changed text. Especially useful when inserting/replacing big chunks of text.
[2020-12-08 Tue] Replacing volatile-highlights with goggles, as the former is not maintained.
(use-package goggles
:if init-flag
:straight (goggles :host github :repo "minad/goggles" :local-repo "~/Git/goggles"
:fork (:host github :repo "yantar92/goggles"))
:diminish goggles-mode
:hook ((text-mode prog-mode) . goggles-mode)
:config
(goggles-define replace expand-abbrev))Highlight evaluated sexp
(use-package eval-sexp-fu :straight t)Expand region
Incrementally expand active region. I only use it occasionally though.
(use-package expand-region
:if init-flag
:straight t
:after org
:bind (:map boon-command-map
("`" . er/expand-region)
:map boon-special-map
("`" . er/expand-region)))
Fold & narrow
Hideshow mode
[2021-05-26 Wed] outline-minor-mode is better than hideshow for buffer cycle (aka org-shifttab), but unfortunately does not support cycling sexps inside functions. So, I am using hideshow for sexp cycling and outline-minor-mode for comment/defun cycling.
It is useful to explore large source code files with hidden details of implementation. I often use it to search interesting things in Emacs packages.
(use-package hideshow
:if init-flag
:straight t
:after outline
:after meta-functions
:diminish hs-minor-mode
:init
(meta-defun meta-tab "Cycle thing at point." ignore)
(meta-defun meta-tab
:mode emacs-lisp-mode
(hs-toggle-hiding))
(meta-defun meta-tab
:mode emacs-lisp-mode
:cond
(save-excursion
(or (save-excursion
(goto-char (line-beginning-position))
(looking-at-p outline-regexp))
(and (bounds-of-thing-at-point 'list)
(goto-char (car (bounds-of-thing-at-point 'list)))
(looking-at-p "^")
(looking-at-p outline-regexp))))
(outline-cycle))
(meta-defun meta-tab
:mode lisp-interaction-mode
(hs-toggle-hiding))
(meta-defun meta-tab
:mode lisp-interaction-mode
:cond
(save-excursion
(or (save-excursion
(goto-char (line-beginning-position))
(looking-at-p outline-regexp))
(and (bounds-of-thing-at-point 'list)
(goto-char (car (bounds-of-thing-at-point 'list)))
(looking-at-p "^")
(looking-at-p outline-regexp))))
(outline-cycle))
:bind (:map hs-minor-mode-map
:filter boon-command-state
("<tab>" . meta-tab))
:hook ((c-mode-common emacs-lisp-mode sh-mode) . hs-minor-mode))outline-minor-mode
It is useful to explore large source code files with hidden details of implementation. I often use it to search interesting things in Emacs packages.
(use-package outline
:if init-flag
:diminish outline-minor-mode
:bind (:map outline-minor-mode-map
:filter boon-command-state
("<tab>" . meta-tab)
("<backtab>" . outline-cycle-buffer))
:hook ((c-mode-common emacs-lisp-mode sh-mode) . outline-minor-mode))Turn on narrow
Narrowing is very useful, especially in large org files or when working with a large function in Elisp code. Enable it.
(when init-flag
(put 'narrow-to-region 'disabled nil))Search & navigation
Text
Case fold search
Ignore case during search by default
(setq-default case-fold-search t)
(use-package isearch
:if init-flag
:config
(setq-default isearch-case-fold-search t))(
use-package helm
:if init-flag
:custom
(helm-set-case-fold-search 'smart))Boon navigation & search
File navigation and search are the most frequent actions for me. Here, I want to make sure that the navigation commands are bind to easily accessible keys on home row of the keyboard.
The core keys for left hand are jkl; uiop, and bn which are easy to access with pointing finger sitting on top of j. I use these keys for buffer navigation.
The left hand is mostly sitting on <SHIFT>sdf with <TAB>wert and zxcv being easily accessible. Note that I do not include a. It is to simplify access to <CTRL><TAB><SHIFT>, which are useful for traditional Emacs keys. Also, left thumb is mostly sitting on <META><SPACE>. Nothing special here.
Exiting insert mode with <ESC> is extremely uncomfortable. I prefer M-l, which is very fast to use.
Because of this, I have to unbind M-l in global map (it calls capitalise word by default).
Note that I use meta-functions here as much as possible to unify the navigation in different major modes.
The n binding to boon-switch-mark and N for pop-global-mark is especially useful because it can jump backward in the mark-ring, exchange region marks, or jump in global mark ring which is especially useful if I temporary move to some place to look for something. Many of the movement functions are also additionally modified to store mark before moving.
(use-package boon
:if init-flag
:demand t
:config
(define-key boon-x-map "n" narrow-map)
(bind-keys ("C-M-S-j" . scroll-other-window)
("C-M-S-k" . scroll-other-window-down)
:map boon-x-map
("e" . eval-last-sexp)
("c" . delete-frame)
:map boon-moves-map
("j" . meta-down)
("J" . meta-down-element)
("k" . meta-up)
("K" . meta-up-element)
("o" . meta-forward)
("O" . meta-forward-element)
("P" . meta-forward-sexp)
("i" . meta-backward)
("I" . meta-backward-element)
("U" . meta-backward-sexp)
("l" . meta-scroll-up)
("L" . meta-scroll-down)
(";" . meta-recenter-top-bottom)
("G" . end-of-buffer)
("g" . boon-goto-map)
;;("U" . move-beginning-of-line)
;;("P" . move-end-of-line)
("u" . boon-beginning-of-line)
("p" . meta-end-of-line)
:map boon-goto-map
("g" . beginning-of-buffer)
("G" . end-of-buffer)
:map boon-command-map
("-" . meta-undo)
("_" . undo-redo)
("~" . boon-repeat-command)
("Q" . kmacro-end-or-call-macro)
("z" . boon-quote-character)
("y" . transpose-chars)
("Y" . transpose-words)
("C-Y" . transpose-sexps)
("n" . boon-switch-mark)
("m" . bm-previous)
("C-k" . meta-cut-element)
:map boon-forward-search-map
("C-SPC" . isearch-forward-regexp)
("C-g" . boon-unhighlight)
("w" . meta-occur)
("g" . meta-goto)
("r" . helm-occur)
("'" . helm-surfraw)
("/" . helm-do-grep-ag)
:map boon-backward-search-map
("C-SPC" . isearch-backward-regexp)
("C-g" . boon-unhighlight)
("e" . meta-occur)
("g" . meta-goto)
:map boon-special-map
("j" . meta-down)
("J" . meta-down-element)
("k" . meta-up)
("K" . meta-up-element)
("o" . meta-forward)
("O" . meta-forward-element)
("i" . meta-backward)
("I" . meta-backward-element)
("l" . meta-scroll-up)
("L" . meta-scroll-down)
(";" . meta-recenter-top-bottom)
;;("U" . move-beginning-of-line)
;;("P" . move-end-of-line)
("u" . boon-beginning-of-line)
("p" . meta-end-of-line)
("c" . boon-c-god)
("z" . boon-quote-character)
("e" . boon-forward-search-map)
("w" . boon-backward-search-map)
("q" . nil)
("g" . boon-goto-map)
("G" . end-of-buffer)
("D" . boon-treasure-region)
("<SPC>" . boon-drop-mark))
(unbind-key "M-l" global-map))Avy mode - qutebrowser like hints to words
I do not move by visual line in files. Instead, I prefer to use avy to move within the line.
(use-package boon
:if init-flag
:defer t
:config
(use-package avy
:straight t
:bind ( :map boon-moves-map
("H" . avy-goto-char-timer)
("h" . avy-goto-char-in-line)
:map boon-special-map
("H" . avy-goto-char-timer)
("h" . avy-goto-char-in-line))
:custom
(avy-timeout-seconds 0.2 "The default is too long.")))End of sentence
Double space convention is outdated.
(setq-default sentence-end-double-space nil)Isearch
Alternative binding for next/previous match
Xah Lee gave an interesting idea to bind extra key in isearch. cite
Following my key binding theme for Helm, I also define extra keys in isearch
(use-package isearch
:if init-flag
:config
(bind-key "M-j" #'isearch-repeat-forward isearch-mode-map)
(bind-key "M-k" #'isearch-repeat-backward isearch-mode-map))Remember previous location after moving around text
Many movement commands save the current position into the mark ring before moving. Do the same for my meta- movement functions.
(use-package meta-functions
:if init-flag
:config
(define-advice meta-up-element (:before (&rest args) push-mark)
"Call `push-mark'"
(when (and (not (region-active-p))
(called-interactively-p))
(push-mark)))
(advice-add 'meta-down-element :before #'meta-up-element@push-mark))Disable “Mark set” message
Since I am using boon and a lot of searching for fast movement in the buffers, the “Mark set” message often spams the minibuffer. Disabling it, since it is not very useful for me anyway.
(when init-flag
;; (use-package helm-lib
;; :config
;; ;; helm overrides the `push-mark' function by default (according to `helm-advice-push-mark' value)
;; ;; advice the override as well
;; (define-advice helm--advice-push-mark (:filter-args (args) disable-message)
;; "Disable \"Mark set\" message."
;; (list (car args) t (caddr args))))
(define-advice push-mark (:filter-args (args) disable-message)
"Disable \"Mark set\" message."
(list (car args) t (caddr args))))Automatically select highlight face
(use-package hi-lock
:if init-flag
:config
(setq hi-lock-auto-select-face t))Links
Browse URL
Just use external browser to open URLs.
(use-package browse-url
:init
(defun yant/browse-url (url &optional new-window)
"Open in mpv or eaf-browser."
(setq url (replace-regexp-in-string ".*scholar\\.google\\.com[^/]*/scholar_url\\?url=\\([^&]+\\).+" "\\1" url))
(if (and (string-match-p "youtube\\.com" url)
(not (string-match-p "/channel" url)))
(browse-url-generic url new-window)
(if (or (string-match-p "author\\.today" url)
(string-match-p "semanticscholar\\.org" url)
(string-match-p "sciencedirect\\.com" url)
(string-match-p "coursera\\.org" url)
(string-match-p "edx\\.org" url)
(string-match-p "connectedpapers\\.com" url)
(string-match-p "reddit\\.com" url)
(string-match-p "doi\\.org" url)
(string-match-p "weibo\\.com" url)
(string-match-p "china\\.mfa\\.gov\\.ua" url)
(string-match-p "archive\\.org" url)
(string-match-p "github\\.com" url)
(string-match-p "habr\\.com" url)
(string-match-p "samlib\\.ru" url)
(string-match-p "weixin\\.qq\\.com" url)
)
;; (eaf-open-browser url)
(browse-url-generic url new-window)
(browse-url-generic url new-window);; (eww url)
)))
(defun yant/browse-url-orgmode-ml (url &optional _)
"Open an orgmode list url using notmuch."
(let ((id (and (string-match "https://orgmode.org/list/\\([^/]+\\)" url)
(match-string 1 url))))
(notmuch-show (format "id:%s" id))))
:custom
(browse-url-handlers '(("https://orgmode.org/list/" . yant/browse-url-orgmode-ml)))
(browse-url-browser-function 'yant/browse-url)
;; (browse-url-browser-function 'browse-url-generic)
(browse-url-generic-program "qutebrowser-call.sh")
:config
(use-package notmuch
:defer t
:config
(use-package w3m
:commands w3m-view-url-with-browse-url)
(bind-key "C-c C-o" #'w3m-view-url-with-browse-url notmuch-show-mode-map)))Imenu
Imenu allows navigating through the buffer structure, according to the major mode.
(use-package imenu
:if init-flag
:config
(use-package helm
:config
(use-package meta-functions :config
(meta-defun meta-goto "Goto place in document." helm-imenu))))Buffers
Switching buffers
Use helm-mini to switch buffers
(use-package helm
:if init-flag
:bind (:map boon-forward-search-map
("b" . helm-mini)
:map boon-backward-search-map
("b" . helm-mini))
:after boon)Skip some uninteresting buffers when switching to next/previous buffer
Credit: nv-elisp comments on Weekly tips/trick/etc/ thread
(load-file "~/Git/skip-buffers-mode/skip-buffers-mode.el")
(use-package skip-buffers-mode
:if init-flag
:load-path "~/Org/skip-buffers-mode/"
:config
(setq skip-buffers-patterns
'("*helm.**" "Warnings"))
(use-package meta-functions
:config
(meta-defun meta-next-buffer "Go forward in buffer." skip-buffers-next-buffer)
(meta-defun meta-previous-buffer "Go backward in buffer." skip-buffers-previous-buffer)))(defvar skip-buffers-patterns
'("*helm.**")
"List of patterns that match buffers to ignore in next/previous-buffer")
(defun skip-buffers--change-buffer (change-buffer)
"Call CHANGE-BUFFER until current buffer is not in `skip-buffers-patterns'"
(let ((initial (current-buffer)))
(funcall change-buffer)
(let ((first-change (current-buffer)))
(catch 'loop
(while (cl-some (lambda (pattern) (string-match-p pattern (buffer-name)))
skip-buffers-patterns)
(funcall change-buffer)
(when (eq (current-buffer) first-change)
(switch-to-buffer initial)
(throw 'loop t)))))))
(defun skip-buffers-next-buffer ()
"Variant of `next-buffer' that skips buffers matching `skip-buffers-patterns'"
(interactive)
(skip-buffers--change-buffer 'next-buffer))
(defun skip-buffers-previous-buffer ()
"Variant of `previous-buffer' that skips buffers matching `skip-buffers-patterns'"
(interactive)
(skip-buffers--change-buffer 'previous-buffer))
;;;###autoload
(define-minor-mode skip-buffers-mode
"Skip buffers you don't want to see."
:global t
:lighter " skp"
:keymap (let ((map (make-sparse-keymap)))
(define-key map [remap next-buffer] 'skip-buffers-next-buffer)
(define-key map [remap previous-buffer] 'skip-buffers-previous-buffer)
map))
(provide 'skip-buffers-mode)Key bindings
Sometimes, I want to switch to previous/next buffer in current window. The definition of previous/next buffer may depend on the major mode though.
(use-package boon
:bind (:map boon-goto-map
("o" . meta-next-buffer)
("i" . meta-previous-buffer)))Go to scratch key binding
There is a significant number cases when I want to quickly pop to scratch buffer. Setting a binding for this.
(when init-flag
(defun yant/show-scratch()
(interactive)
(pop-to-buffer "*scratch*"))
(use-package boon
:bind (:map boon-goto-map
("8" . yant/show-scratch))))Kill buffer & buffer manipulation/movement
The default function to kill buffer bound to C-x k always ask for a buffer to kill. I often just need to kill current buffer without redundant confirmation.
(when init-flag
(defun yant/kill-this-buffer ()
"Kill current buffer."
(interactive)
(kill-buffer (current-buffer)))
(bind-key "C-x q" #'yant/kill-this-buffer))Windows
Window layout management
If we use boon, it frees up M-digit bindings.
I use them to manage windows. It is much faster than default.
Also, improve the default commands by using windower.
Instead of delete-other-windows, use windower's version, which toggles maximised/original layout.
(use-package boon
:if init-flag
:init
(use-package windower
:straight (emacs-windower :host gitlab :repo "ambrevar/emacs-windower" :local-repo "~/Git/emacs-windower"
:fork (:host gitlab :repo "yantar92/emacs-windower")))
:config
(bind-keys*
("M-1" . windower-toggle-single)
("M-2" . split-window-below)
("M-0" . delete-window)
("M-3" . split-window-right)
("M-4" . (lambda () (interactive)
(split-window-right)
(call-interactively #'clone-indirect-buffer-other-window)))))Sometimes, there is a need to split window vertically or horizontally, but I make a mistake and split in wrong direction.
Then I used to delete the window (M-0) and re-split, but can as well save a keystroke if I can change direction of the split.
(use-package windower
:bind ("M-`" . #'windower-toggle-split))Window selection
Use boon-*-search-map to select windows and C-M-l to cycle current window.
(use-package windmove
:bind (("M-'" . other-window)
:map boon-forward-search-map
("j" . windmove-down)
("k" . windmove-up)
("i" . windmove-left)
("o" . windmove-right)))Undo window configuration changes
(when init-flag
(winner-mode +1)
(use-package boon
:bind (:map boon-goto-map
("u" . winner-undo)
("p" . winner-redo))))Recentering text in window
By default help:recenter-top-bottom goes in the following order: middle top bottom. However, most of time I use this function is aligning text to top of the window.
(when init-flag
(setq recenter-positions '(top middle bottom)))Frame
Deleting frame
I need an extra binding here to make x c work in boon command map.
(when init-flag
(global-set-key (kbd "C-x C-c") 'delete-frame)
(global-set-key (kbd "C-x c") 'delete-frame))Detach current window from the frame
I keep forgetting this, but it is sometimes useful to detach current window into separate frame. For example, debugger window may sometimes occupy too much of frame space and detaching it from the frame can be useful.
(when init-flag
(defun my/tear-off-window ()
"Delete the selected window, and create a new frame displaying its buffer."
(interactive)
(let* ((window (selected-window))
(buf (window-buffer window))
(frame (make-frame)))
(select-frame frame)
(switch-to-buffer buf)
(delete-window window)))
(use-package boon
:config
(bind-key "M-5" #'my/tear-off-window)))Files
Find files
I use helm to find files. Binding to boon-*-search-map, since it is logical.
(use-package boon
:if init-flag
:config
(bind-keys :map boon-forward-search-map
("f" . helm-find-files)
("F" . helm-locate)
:map boon-backward-search-map
("f" . helm-find-files)
("F" . helm-locate)))Open files as root
- Refiled on [2020-04-20 Mon 21:21]
- State “TODO” from [2018-01-10 Wed 02:41]
(when init-flag
;; http://emacs.readthedocs.io/en/latest/file_management.html
(defun yt/sudo-find-file (file-name)
"Like find file, but opens the file as root."
(interactive "FSudo Find File: ")
(let ((tramp-file-name (concat "/sudo::" (expand-file-name file-name))))
(find-file tramp-file-name)))
(use-package boon
:defer t
:bind (:map boon-forward-search-map
("M-f" . yt/sudo-find-file)
("M-S-f" . (lambda () (interactive) (yt/sudo-find-file (buffer-file-name))))
:map boon-backward-search-map
("M-f" . yt/sudo-find-file)
("M-S-f" . (lambda () (interactive) (yt/sudo-find-file (buffer-file-name)))))))Directories
Dired
- State “NEXT” from “TODO” [2018-10-08 Mon 14:55]
- State “TODO” from [2018-03-12 Mon 14:57]
- State “CANCELLED” from [2017-05-28 Sun 17:46]
Run dired from boon-*-search-map
(use-package boon
:if init-flag
:config
(bind-keys :map boon-forward-search-map
("d" . dired)
:map boon-backward-search-map
("d" . dired)))And extend it with dired+
(use-package dired+
:if init-flag
:straight t
:after dired)dired+ mode-line. Too much performance degradation
;; (when init-flag
;; (remove-hook 'dired-after-readin-hook #'diredp-nb-marked-in-mode-name))Key bindings
Dired bindings
(use-package dired
:if init-flag
:bind (:map dired-mode-map
("W" . dired-copy-filename-as-kill)
("s" . dired-mark)
("a" . dired-unmark)
("A" . dired-unmark-all-marks))
:config
(use-package dired-filter
:defer t
:bind (:map dired-filter-group-header-map
("<tab>" . dired-filter-group-toggle-header))
:config
(set-face-attribute 'dired-filter-group-header nil
:underline nil)
;; (unbind-key "<tab>" dired-filter-group-mode-map)
)
(use-package meta-functions
:init
(use-package dired-hacks-utils :straight t)
:config
(meta-defun meta-down :mode dired-mode dired-hacks-next-file)
(meta-defun meta-up :mode dired-mode dired-hacks-previous-file)
(meta-defun meta-up-element :mode dired-mode dired-up-directory)
(meta-defun meta-up-element :mode dired-mode :cond (get-text-property (point) 'dired-filter-group-header) dired-filter-group-backward-drawer)
(meta-defun meta-down-element :mode dired-mode dired-filter-group-forward-drawer)
(meta-defun meta-return :mode dired-mode :cond (get-text-property (point) 'dired-filter-group-header) dired-filter-group-toggle-header)
(meta-defun meta-return :mode dired-mode :cond (get-text-property (point) 'dired-filter-group-header) dired-filter-group-toggle-header)
))Image-dired bindings
review capabilities of image-diredEND
(use-package image-dired
:if init-flag
:bind (:map image-dired-thumbnail-mode-map
("s" . image-dired-mark-thumb-original-file)
("a" . image-dired-unmark-thumb-original-file)
("A" . image-dired-unmark-all-thumbs-original-files))
:init
(defun image-dired-unmark-all-thumbs-original-files ()
"Unmark all original image files in associated dired buffer."
(interactive)
(when-let ((dired-buf (image-dired-associated-dired-buffer)))
(with-current-buffer dired-buf
(dired-unmark-all-marks))))
:config
(unbind-key "o" image-map)
(use-package meta-functions
:config
(meta-defun meta-forward :mode image-dired-thumbnail-mode image-dired-forward-image)
(meta-defun meta-backward :mode image-dired-thumbnail-mode image-dired-backward-image)
(meta-defun meta-down :mode image-dired-thumbnail-mode image-dired-next-line)
(meta-defun meta-up :mode image-dired-thumbnail-mode image-dired-previous-line)))Narrowing \ live filter dired-narrow
Credit: Dynamically filter directory listing with dired-narrow | Pragmatic Emacs Repo: [[id:Github-fuco1-fuco1-dired-hacks-707][Fuco1 [Github] Fuco1/dired-hacks: Collection of useful dired additions]]
(use-package dired-narrow
:if init-flag
:straight t
:bind (:map dired-mode-map
("/" . dired-narrow)))Browse archives with dired-avfs
(use-package dired-avfs
:if init-flag
:straight t
:after dired
:init
(start-process "mountavfs" nil "mountavfs"))DWIM target on copy/rename
(use-package dired
:custom (dired-dwim-target t))Automatically kill dired buffers pointing to deleted directories
(use-package dired
:if init-flag
:custom
(dired-clean-confirm-killing-deleted-buffers nil))Kill all the previous dired buffers when quitting
By default, every time I enter a new directory from dired, a new dired buffer is created.
This makes it annoying to exit the dired buffer since I would need to press “q” many times.
Some people solve this problem by using
Kill all the dired buffers in the window until non-=dired= buffer on “q”
(use-package dired
:if init-flag
:bind (:map dired-mode-map
("q" . dired-quit-window))
:init
(defun dired-quit-window (&optional kill window)
"Run `quit-window' until first non-dired buffer in the current window."
(interactive)
(let ((window (or window (selected-window))))
(with-selected-window window
(while (and (window-live-p window)
(eq major-mode 'dired-mode))
(quit-window kill window))))))Image dired
suggest to add to emacs?ENDUnselect all the files after showing thumbnails. Useful to mark files from the image-dired buffer.
(use-package image-dired
:if init-flag
:config
(define-advice image-dired-display-thumbs (:after (&rest _) unmark-all-files)
"Unmark all files in current dired buffer."
(when (eq major-mode 'dired-mode)
(dired-unmark-all-marks))))Increase the border size around thumbnails. Default size make it difficult to me spotting the cursor position. Inspired by: [[id:4bc3aabf24f87d95784e463c42b4e114bce3be59][[Protesilaos] GNU Emacs integrated computing environment | Protesilaos Stavrou]]
(use-package image-dired
:if init-flag
:custom
(image-dired-thumb-relief 6))Increase the thumbnail size
(use-package image-dired
:if init-flag
:custom
;; Default is 100.
(image-dired-thumb-size 400))Delete to trash
Using trash is safer.
(use-package dired
:if init-flag
:custom
(delete-by-moving-to-trash t)
(trash-directory "~/tmp/Trash"))Open file in external app from dired
(use-package dired-open
:if init-flag
:straight t
:bind (:map dired-mode-map
("<return>" . dired-open-xdg)))Async operations
(use-package dired
:if init-flag
:init
(use-package async
:straight t
:config
(use-package dired-async))
:hook (dired-mode . dired-async-mode))Follow symlink structure
- State “TODO” from [2018-07-23 Mon 15:45]
dired-find-file calls find-file, which calls find-file-noselect, which forces abbreviate-file-name to be applied.
It makes entering symlink in ~/Dropbox/Org/->~/Org go into “~/Org”.
As a result, dired-up-directory goes to ~/ instead of ~/Dropbox.
Hence, I avoid abbreviate-file-name in dired-find-file.
Same for dired-noselect (called by dired, which is called by dired-up-directory).
(define-advice dired-find-file (:around (OLDFUN &rest args) disable-abbreviate-file-name)
"Disable `abbreviate-file-name' in dired."
(cl-flet ((abbreviate-file-name (filename) ""
(if (f-directory? filename)
(f-slash filename)
filename)))
(apply OLDFUN args)))
(advice-add 'dired-noselect :around #'dired-find-file@disable-abbreviate-file-name)Do not update mode-line info as in dired+
diredp-nb-marked-in-mode-name from dired+ is very too slow.
Disabling it
(use-package dired+
:if init-flag
:after dired+
:config
(remove-hook 'dired-after-readin-hook 'diredp-nb-marked-in-mode-name)
(remove-hook 'dired-mode-hook 'diredp-nb-marked-in-mode-name))
Appearance
File icons
(use-package all-the-icons-dired
:if init-flag
:straight t
:diminish all-the-icons-dired-mode
:hook (dired-mode . all-the-icons-dired-mode))Highlight files
Additional fontification in dired
(use-package diredfl
:if init-flag
:straight t
:config
(diredfl-global-mode 1))Group files
(use-package dired-filter
:if init-flag
:straight t
:custom (dired-filter-group-saved-groups '(("default"
("Dirs"
(directory . nil))
("Archives"
(extension "zip" "rar" "gz" "bz2" "tar"))
("Documents"
(extension "org" "cfm" "pdf" "tex" "bib" "mobi" "fb2" "doc" "docx" "ps"))
("Scripts"
(extension "gnuplot" "sh"))
("Data"
(extension "txt" "hys" "xls" "xlsx"))
("Images"
(extension "png" "jpg" "jpeg" "tiff" "tif" "svg"))
("Videos"
(extension "avi" "mpeg" "mp4" "mkv"))
)))
:hook (dired-mode . dired-filter-group-mode))Hide uninteresting files
- Refiled on [2020-04-14 Tue 14:16]
Hide dotfiles
(use-package dired-hide-dotfiles
:if init-flag
:straight (dired-hide-dotfiles :host github :repo "yantar92/dired-hide-dotfiles" :local-repo "~/Git/dired-hide-dotfiles")
:hook (dired-mode . dired-hide-dotfiles-mode)
:bind (:map dired-mode-map
("." . dired-hide-dotfiles-mode)))Hide “.” and “..”
(use-package dired
:custom (dired-listing-switches "-DlhGgA"))Hide details
Do not hide symlink target when hiding details.
(use-package dired
:if init-flag
:custom (dired-hide-details-hide-symlink-targets nil))Show last commit in Git repos
Credit: [[id:Reddit:planetemacs_/u/negativeoilprice2021show_hide_emacs_dired_detail_in_stylebeb][/u/negativeoilprice [Reddit:planetemacs] (2021) Show/hide Emacs dired details in style]]
(use-package dired-git-info
:if init-flag
:straight t
:bind (:map dired-mode-map
(")" . dired-git-info-mode)))Disk usage
(use-package disk-usage
:if init-flag
:straight t
:config
(meta-defun meta-up-element :mode disk-usage-mode disk-usage-up))Fix ange-ftp using dired-listing-switches even when ftp server does not accept them
(define-advice ange-ftp-ls (:around (oldfun file lsargs parse &optional no-error wildcard) force-default-ls-switches)
"Always use -al in ftp."
(unless (string= lsargs "-al")
(setq lsargs "-Al --dired"))
(apply oldfun (list file "-al" parse no-error wildcard)))Documentation
helm-dash
Emacs has an excellent built-in support for Elisp and GNU system documentation. Moreover, it can be integrated with all other kinds of documentation using Dash.
(use-package helm-dash
:if init-flag
:straight t
:demand t
:custom
(dash-docs-enable-debugging nil)
(helm-dash-docsets-path (no-littering-expand-var-file-name "dash-docs/docsets"))
(dash-docsets-path (no-littering-expand-var-file-name "dash-docs/docsets"))
(helm-dash-browser-func 'eww)
(helm-dash-common-docsets '("Bash" "LaTeX" "Python 3"))
:config
(add-hook! latex-mode (setq dash-docs-docsets '("LaTeX")))
(add-hook! sh-mode (setq dash-docs-docsets '("Bash")))
(use-package helm-dash
:config
(meta-defun meta-help :mode latex-mode (helm-dash (concat "LaTeX " (thing-at-point 'symbol))))
(meta-defun meta-help :mode sh-mode (helm-dash (concat "Bash " (thing-at-point 'symbol))))
(meta-defun meta-help :mode python-mode (helm-dash (concat "Python 3 " (thing-at-point 'symbol))))))latex2e info documentation
See TeX \ LaTeX (texlive)
(add-to-list 'Info-additional-directory-list "/usr/share/texmf-dist/doc/info/")Bookmarks
- Refiled on [2020-05-12 Tue 15:22]
- State “CANCELLED” from “TODO” [2020-04-09 Thu 17:22]
(use-package bm
:if init-flag
:straight t
:after no-littering
:demand t
:init
;; restore on load (even before you require bm)
(setq bm-restore-repository-on-load t)
:config
(use-package helm-bm :straight t)
;; Allow cross-buffer 'next'
(setq bm-cycle-all-buffers t)
;; highligh style
(setq bm-highlight-style 'bm-highlight-line-and-fringe)
(custom-set-faces '(bm-persistent-face ((t (:background "Lightyellow")))))
(custom-set-faces '(bm-fringe-persistent-face ((t (:background "Lightyellow")))))
;; save bookmarks
(setq-default bm-buffer-persistence t)
;; Loading the repository from file when on start up.
(add-hook' after-init-hook 'bm-repository-load)
;; Saving bookmarks
(add-hook 'kill-buffer-hook #'bm-buffer-save)
;; Saving the repository to file when on exit.
;; kill-buffer-hook is not called when Emacs is killed, so we
;; must save all bookmarks first.
(add-hook 'kill-emacs-hook #'(lambda nil
(bm-buffer-save-all)
(bm-repository-save)))
;; The `after-save-hook' is not necessary to use to achieve persistence,
;; but it makes the bookmark data in repository more in sync with the file
;; state.
(add-hook 'after-save-hook #'bm-buffer-save)
;; Restoring bookmarks
(add-hook 'find-file-hooks #'bm-buffer-restore)
(add-hook 'after-revert-hook #'bm-buffer-restore)
;; The `after-revert-hook' is not necessary to use to achieve persistence,
;; but it makes the bookmark data in repository more in sync with the file
;; state. This hook might cause trouble when using packages
;; that automatically reverts the buffer (like vc after a check-in).
;; This can easily be avoided if the package provides a hook that is
;; called before the buffer is reverted (like `vc-before-checkin-hook').
;; Then new bookmarks can be saved before the buffer is reverted.
;; Make sure bookmarks is saved before check-in (and revert-buffer)
(add-hook 'vc-before-checkin-hook #'bm-buffer-save)
(use-package meta-functions
:defer t
:config
(meta-defun meta-down-element :mode bm-show-mode bm-show-next)
(meta-defun meta-up-element :mode bm-show-mode bm-show-prev))
:bind (:map boon-command-map
("N" . bm-toggle)
("M-n" . bm-bookmark-annotate)
:map boon-insert-map
("M-N" . bm-toggle)
("C-M-N" . bm-toggle)
:map boon-goto-map
("n" . bm-show)
("N" . helm-bm)
:map boon-forward-search-map
("n" . bm-next)
:map boon-backward-search-map
("n" . bm-previous)
:map bm-show-mode-map
("<tab>" . bm-show-goto-bookmark)
)
)Do not fontify bookmarks. It does not look nice on bookmarks automatically created by org-capture
(use-package bookmark
:if init-flag
:custom
(bookmark-fontify nil))Editing
Ingest primary selection from OS
(when init-flag
(setq select-enable-primary t)
(setq save-interprogram-paste-before-kill t))Boon - set command state from insert state
The boon’s default ESC key binding to go back to command state is too hard to press.
I prefer a key on home row.
M-l have proven to be good enough for me.
(use-package boon
:if init-flag
:config
(bind-key "M-l" 'boon-set-command-state boon-insert-map))Multiple cursors
I use multiple cursors in very limited way. Mostly just one command - editing multiple lines from selection. Bind it to command mode in boon.
(use-package boon
:if init-flag
:config
(use-package multiple-cursors
:defer t
:bind (:map boon-command-map
("C-V" . mc/edit-beginnings-of-lines))))Open current line
This is one of the frequently used commands and I want it to be available from command state. However, org has its own version of open-line. So, I define a meta-function to make open-line work as correctly regardless of the mode.
(use-package boon
:if init-flag
:config
(meta-defun meta-open-line "Create an empty line above point." boon-open-line)
(use-package org
:defer t
:config
(meta-defun meta-open-line :mode org-mode org-open-line))
(bind-key "C-o" 'meta-open-line boon-command-map))Also, don’t break the current line if the cursor is in the middle of a line
(use-package simple
:if init-flag
:config
(define-advice open-line (:before (&rest args) mote-to-beg-first)
(beginning-of-line)))Cut element at point
- Refiled on [2020-04-14 Tue 15:47]
(use-package meta-functions
:if init-flag
:config
(meta-defun meta-cut-element () "Cut element at point" kill-paragraph))Query replace
Use a query replace version with nice highlights.
(use-package boon
:if init-flag
:config
(use-package visual-regexp
:straight t
:bind (:map boon-command-map
("?" . vr/query-replace))))Indent region
(when init-flag
(bind-key* "C-<tab>" 'indent-region))Aggressive indent
Automatic indentation is handy to keep the code nice and readable.
(use-package aggressive-indent
:if init-flag
:straight t
:diminish aggressive-indent-mode
:config
(add-hook 'prog-mode-hook #'aggressive-indent-mode))Inhibit message that indentation is completed
(define-advice indent-region (:around (fun &rest args) silence)
"Do not show meessages."
(let ((inhibit-message t))
(apply fun args)))Delete backward key bindings
Deleting a char/word backward is pretty common command when typing.
However, <DEL> key is too far on keyboard.
I prefer something on home row - C-h and C-M-h.
(when init-flag
(bind-keys ("C-M-h" . backward-kill-word)
("C-h" . backward-delete-char-untabify)
:map isearch-mode-map
("C-h" . isearch-delete-char)
("C-M-h" . isearch-delete-char)))Smarter backward-kill-word
From reddit.
(when init-flag
(defun user/smarter-backward-kill-word ()
"Deletes the previous word, respecting:
1. If the cursor is at the beginning of line, delete the '\n'.
2. If there is only whitespace, delete only to beginning of line.
3. If there is whitespace, delete whitespace and check 4-5.
4. If there are other characters instead of words, delete one only char.
5. If it's a word at point, delete it."
(interactive)
(if (bolp)
;; 1
(delete-char -1)
(if (string-match-p "^[[:space:]]+$"
(buffer-substring-no-properties
(line-beginning-position) (point)))
;; 2
(delete-horizontal-space)
(when (thing-at-point 'whitespace)
;; 3
(delete-horizontal-space))
(if (thing-at-point 'word)
;; 5
(let ((start (car (bounds-of-thing-at-point 'word)))
(end (point)))
(if (> end start)
(delete-region start end)
(delete-char -1)))
;; 4
(delete-char -1)))))
(bind-key [remap backward-kill-word] #'user/smarter-backward-kill-word))Return key
adjust keybindings to avoid interference with WMENDMeta-versions of return/return-dwim commands. Mostly intended to use with org.
(define-key key-translation-map (kbd "C-j") (kbd "<RET>"))
(use-package meta-functions
:if init-flag
:config
(use-package boon
:bind (:map boon-command-map
("<RET>" . meta-new-line)
("C-M-j" . meta-insert-enclosure-new-line)
("C-J" . meta-insert-active-enclosure-new-line)
:map boon-insert-map
("<RET>" . meta-new-line)
("C-M-j" . meta-insert-enclosure-new-line)
("C-J" . meta-insert-active-enclosure-new-line))))Do no yank with mouse, but use Shift-Ins to yank the primary selection
I do not use mouse as much as possible and discourage myself to use it unnecessarily.
(when init-flag
(bind-key "<S-insert>" (lambda () (interactive)
(insert (gui-get-primary-selection))))
(bind-key "<mouse-2>" #'ignore))Move lines, elements around
(use-package meta-functions
:if init-flag
:demand t
:config
(use-package move-text
:straight t
:demand t
:bind (:map boon-command-map
("M-j" . meta-move-line-down)
("M-k" . meta-move-line-up)
("M-J" . meta-move-element-down)
("M-K" . meta-move-element-up)
("M-O" . meta-move-element-right)
("M-I" . meta-move-element-left)
("M-o" . meta-move-line-right)
("M-i" . meta-move-line-left)
:map boon-special-map
("M-j" . meta-move-line-down)
("M-k" . meta-move-line-up)
("M-J" . meta-move-element-down)
("M-K" . meta-move-element-up)
("M-O" . meta-move-element-right)
("M-I" . meta-move-element-left)
("M-o" . meta-move-line-right)
("M-i" . meta-move-line-left))
:config
(meta-defun-mapc '((meta-move-line-right "Move the line under cursor right." ignore)
(meta-move-line-left "Move the line under cursor left." ignore)
(meta-move-line-up "Move the line under cursor up." move-text-line-up)
(meta-move-line-down "Move the line under cursor down." move-text-line-down)
(meta-move-element-right "Move the element under cursor right." ignore)
(meta-move-element-left "Move the element under cursor left." ignore)
(meta-move-element-down "Move the element under cursor down." move-text-down)
(meta-move-element-up "Move the element under cursor up." move-text-up))))
:init (use-package boon))Yasnippet
Yasnippet is a very handy way to use templates as you type.
There is also built-in skeleton mode, but yasnippet also has a good user-contributed snippet database.
(use-package yasnippet
:if init-flag
:straight t
:diminish (yas-minor-mode . " ⇶_")
:hook ((org-mode latex-mode markdown-mode prog-mode lisp-interaction-mode) . yas-minor-mode)
:config
(use-package yasnippet-snippets
:straight t)
(yas-reload-all))Auto-expand snippets without a need to type trigger command
[[id:Github:joaotavora/yasnippet_bumbker2019issue9c8f][bumbker [Github:joaotavora/yasnippet] (2019) issue#998:]]
Note that auto is important here as some snippets would be too aggressive.
I also added self-insert-command check to avoid calling, say, on movement commands.
(use-package yasnippet
:if init-flag
:after yasnippet
:config
(defun my-yas-try-expanding-auto-snippets ()
(when (and (boundp 'yas-minor-mode) yas-minor-mode)
(let ((yas-buffer-local-condition ''(require-snippet-condition . auto)))
(when (eq this-command 'self-insert-command)
(yas-expand)))))
(add-hook 'post-command-hook #'my-yas-try-expanding-auto-snippets))Org mode snippets
# -*- mode: snippet -*-
# name: LaTeX equation
# key: <eq
# --
\begin{equation}
$0
\end{equation}
Undo
SOMEDAY Editing outside emacs
emacs-anywhere allows to invoke emacs for editing in any other application
(use-package emacs_anywhere
:disabled t
:straight (emacs_anywhere :type git :host github :repo "zachcurry/emacs-anywhere"))Fill/unfill paragraph
Interactive fill/unfill paragraph at point.
(when init-flag
;; https://github.com/jethrokuan/.emacs.d/blob/master/init.el
(defun endless/fill-or-unfill ()
"Like `fill-paragraph', but unfill if used twice."
(interactive)
(let ((fill-column
(if (eq last-command 'endless/fill-or-unfill)
(progn (setq this-command nil)
(point-max))
fill-column)))
(call-interactively #'fill-paragraph)))
(use-package boon
:defer t
:bind (:map boon-command-map
("M-q" . endless/fill-or-unfill))))Debugging
Command loop
Debug on error
- State “CANCELLED” from [2017-12-19 Tue 08:53]
(when init-flag
(setq debug-on-error t)
(setq debug-on-quit nil)
(setq debug-ignored-errors '(beginning-of-line
beginning-of-buffer
end-of-line
end-of-buffer
end-of-file
buffer-read-only
quit
file-supersession
mark-inactive
user-error
search-failed
file-missing
file-date-error
"notmuch search process already running"
"epdfinfo: Unable to create synctex scanner"
"Too few elements on stack"
"Abort"
"Trying to run helm within a running helm session"
"Already at top level of the outline"
"Attempt to delete the sole visible or iconified frame"
"No such page"
"use-package: :[a-z]+ wants"
"The mark is not set now, so there is no region"
"Search string not set"
"use-package: Unrecognized keyword"
"No more buttons"
"No command bound to"
"Decryption failed"
"No such action"
"Cannot outdent an item without its children"
"Attempt to delete minibuffer or sole ordinary window"
"profiler is already running"
"Bumped into unknown token")))Debugger key bindings
(use-package debug
:if init-flag
:config
(bind-key "s" #'debugger-continue debugger-mode-map))Appearance
Use visible bell
Visible bell saved me from surprise prompts many times.
(setq visible-bell t)Do not ring the bell when I quit some command via C-g or ESC.
Credit: bradwright/emacs.d: My Emacs configuration
(setq ring-bell-function
(lambda ()
"Only rings the bell if it's not a valid quit case, e.g
keyboard-quit"
(unless (memq this-command
'(isearch-abort abort-recursive-edit exit-minibuffer keyboard-quit))
(ding))))(expr ...) instead of expr( ... ) in debugger
From: https://github.com/cadadr/configuration/blob/master/emacs.d/init.el
(when init-flag
(setq
;; (expr ...) not expr(...)
debugger-stack-frame-as-list t))Lorem ipsum
Sometimes, I just need to have any random text in buffer for testing.
(use-package lorem-ipsum
:if init-flag
:straight t)Bug hunting in init.el
- Refiled on [2020-04-27 Mon 15:06]
(use-package bug-hunter
:if init-flag
:straight t)Hung memory leaks
(use-package memory-usage
:if init-flag
:straight t)Debugging of font-lock
By default, font-locking is not debuggable because all the errors thrown by fontification functions are catched and cause the functions to be removed. It indeed makes sense since errors in fontification functions can easily hang Emacs. However, it makes debugging such functions very difficult.
Here is the solution: Lindydancer/font-lock-studio: Debugger for Font Lock keywords
Just invoke M-x font-lock-studio for interactive debugging.
(use-package font-lock-studio
:if init-flag
:straight (font-lock-studio :type git :host github :repo "Lindydancer/font-lock-studio")
:config
(bind-keys :map font-lock-studio-mode-map
("d" . font-lock-studio-step-into)))The same author also wrote font-lock profiler: [[id:github_lindydancer_lindy_font_lock_profil_cover][Lindydancer [Github] Lindydancer Font-Lock-Profiler: Coverage and Timing Tool for Font-Lock Keywords]]
(use-package font-lock-profiler
:if init-flag
:straight (font-lock-profiler :type git :host github :repo "Lindydancer/font-lock-profiler"))Profiling font-lock
Similar to the problem with debugging, profiling the time spend on fontification can be tricky.
font-lock-profiler helps with finding bottlenecks in org-fold.
(use-package font-lock-profiler
:if init-flag
:straight (font-lock-profiler :host github :repo "Lindydancer/font-lock-profiler"))Debugging macros using macrostep
(use-package macrostep
:if init-flag
:straight t)Profiler
Appearance
Programming & emacsing
Emacs help
There are various ways Emacs can assist on getting documentation.
Symbol&info lookup
Quick documentation access is one of the most powerful features of emacs.
Helm makes searching the documentation lightning fast.
We can search:
- functions, variables, other symbols
.elfiles- key bindings
- info entries for anything
- man entries
The default elisp info search does not include many useful libraries like cl-lib, dash, or EIEIO.
I rely on the search so much that I, for example, did not even know about =cl-lib for a long time and still struggling to use it efficiently.
Expanding helm completion to include everything.
(when init-flag
;;Modified from https://www.reddit.com/r/emacs/comments/e5dzv6/weekly_tipstricketc_thread/f9xug5q/
(defun helm-info-elisp-and-libs ()
"Helm for Emacs, Elisp, and CL-library info pages."
(interactive)
(helm :sources '(helm-source-info-dash
helm-source-info-eieio
helm-source-info-elisp
helm-source-info-cl))))Similarly, many emacs features are hidden in separate info nodes.
(when init-flag
(defun helm-info-emacs-and-extra ()
"Helm for Emacs, Elisp, and CL-library info pages."
(interactive)
(helm :sources '(helm-source-info-emacs
helm-source-info-autotype
helm-source-info-magit
helm-source-info-tramp))))Explore loaded library files
(use-package helm
:if init-flag
:bind (("<f1> l" . helm-locate-library)))Man
(use-package woman
:if init-flag
:commands woman
:config
(use-package meta-functions
:config
(meta-defun meta-down-element :mode woman-mode Man-next-section)
(meta-defun meta-up-element :mode woman-mode Man-previous-section)))TL;DR - short practical version of man
(use-package tldr
:if init-flag
:straight t)Appearance
Helpful - better help buffers
For theelisp built-in docstrings, helpful package extension with very useful.
It provides extra functionality to the standard help buffers.
(use-package helpful
:if init-flag
:straight (helpful :host github :repo "Wilfred/helpful" :local-repo "~/Git/helpful"
:fork (:host github :repo "yantar92/helpful")))Elisp demos
Another package elisp-demos extends helpful even further providing examples to many standard functions.
(use-package elisp-demos
:if init-flag
:straight t
:config
(advice-add 'helpful-update :after #'elisp-demos-advice-helpful-update))Command loop
Explore keymaps
(use-package helm
:if init-flag
:defer t
:config
(use-package helm-descbinds :straight t))Show the continuation of unfinished keybindings
(use-package which-key
:if init-flag
:straight t
:diminish which-key-mode
:config
(which-key-mode))Help buffer navigation
(use-package boon
:defer t
:if init-flag
:config
(use-package meta-functions
:config
(meta-defun meta-next-buffer :mode help-mode help-go-forward)
(meta-defun meta-previous-buffer :mode help-mode help-go-back)))Info buffer navigation
(use-package boon
:defer t
:if init-flag
:config
(use-package meta-functions
:config
(meta-defun meta-down-element :mode Info-mode Info-forward-node)
(meta-defun meta-up-element :mode Info-mode Info-backward-node)
(meta-defun meta-new-line :mode Info-mode Info-follow-nearest-node)
(meta-defun meta-previous-buffer :mode Info-mode Info-history-back)
(meta-defun meta-next-buffer :mode Info-mode Info-history-forward)))Global key bindings
(use-package helm
:if init-flag
:demand t
:after helm-dash
:config
;; Update the info file list.
(custom-reevaluate-setting 'helm-default-info-index-list)
:init
(use-package boon
:config
(meta-defun meta-help "Get help on symbol at point." ignore)
(meta-defun meta-help :mode org-mode :cond (org-in-src-block-p) helpful-at-point)
(meta-defun meta-help :mode emacs-lisp-mode helpful-at-point)
(meta-defun meta-help :mode lisp-interaction-mode helpful-at-point)
(meta-defun meta-help :mode helpful-mode helpful-at-point)
(meta-defun meta-help :mode help-mode helpful-at-point)
(meta-defun meta-help :mode profiler-report-mode helpful-at-point)
(meta-defun meta-help :mode debugger-mode helpful-at-point)
(meta-defun meta-help :mode notmuch-message-mode helpful-at-point)
(meta-defun meta-help :mode notmuch-show-mode helpful-at-point)
(meta-defun meta-help :mode Info-mode helpful-at-point)
(bind-keys ("<F1> k" . helpful-key)
:map boon-goto-map
("k" . helpful-key)
("f" . helpful-callable)
("v" . meta-help)
("d" . helpful-variable)
("s" . helpful-symbol)
("b" . helm-descbinds)
("h h" . helm-info)
("h m" . man)
("h n" . tldr)
("h i" . helm-info-elisp-and-libs)
("h o" . helm-info-org)
("h e" . helm-info-emacs-and-extra)
("h t" . helm-info-auctex)
("h T" . helm-info-texinfo))))Elisp coding
Use spaces for indenting
(add-hook! emacs-lisp-mode (setq indent-tabs-mode nil))Indicate fill column
#display-fill-column-indicator-mode(when init-flag
(setq fill-column 80)
(add-hook! (emacs-lisp-mode lisp-interaction-mode) #'display-fill-column-indicator-mode))Paredit
- Refiled on [2020-04-23 Thu 14:42]
Smarter elisp editing
(use-package paredit
:if init-flag
:straight t
:diminish (paredit-mode . " (⤑)")
:demand t ;; I need it in scratch buffer
:hook ((lisp-mode lisp-interaction-mode emacs-lisp-mode) . paredit-mode)
:config
(use-package boon
:defer t
:after meta-functions
:config
(meta-defun meta-move-line-right :mode emacs-lisp-mode paredit-forward-slurp-sexp)
(meta-defun meta-move-line-right :mode lisp-interaction-mode paredit-forward-slurp-sexp)
(meta-defun meta-move-line-left :mode emacs-lisp-mode paredit-convolute-sexp)
(meta-defun meta-move-line-left :mode lisp-interaction-mode paredit-convolute-sexp)
(meta-defun meta-split :mode emacs-lisp-mode paredit-split-sexp)
(meta-defun meta-split :mode lisp-interaction-mode paredit-split-sexp)
(meta-defun meta-forward-element :mode emacs-lisp-mode paredit-forward)
(meta-defun meta-forward-element :mode lisp-interaction-mode paredit-forward)
(meta-defun meta-backward-element :mode emacs-lisp-mode paredit-backward)
(meta-defun meta-backward-element :mode lisp-interaction-mode paredit-backward)
(bind-keys :map boon-insert-map
("M-o" . meta-move-line-right)
("M-i" . meta-move-line-left))))Use paredit in M-: minibuffer
Inspired by https://github.com/cadadr/configuration/blob/master/emacs.d/init.el
(use-package paredit
:if init-flag
:init
(defun yant/paredit-enable-maybe-minibuffer ()
"Enable paredit in minibuffer when running `eval-expression'."
(when (eq this-command 'eval-expression)
(paredit-mode +1)))
(bind-keys :map minibuffer-mode-map
("M-o" . paredit-forward-slurp-sexp)
("M-i" . paredit-convolute-sexp))
(add-hook 'minibuffer-setup-hook #'yant/paredit-enable-maybe-minibuffer))Font-lock based namespace for writing modes
The convention for writing Emacs packages is using the package name as prefix for every dynamically scoped variable in the package.
The result is useful to avoid mess in the global variables, but also makes the variable and function names too long.
nameless provides a convenient way to hide those long prefixes.
(use-package nameless
:if init-flag
:straight t
:diminish (nameless-mode . "::")
:init
(add-hook 'emacs-lisp-mode-hook #'nameless-mode)
:config
(setq nameless-private-prefix t)
(bind-key "_" #'nameless-insert-name-or-self-insert nameless-mode-map))Show elisp result in overlay
(use-package eros
:if init-flag
:straight t
:hook ((lisp-mode lisp-interaction-mode emacs-lisp-mode) . eros-mode))Smart redefining functions
Sometimes, advises and hooks are simply not enough to alter existing functions. The only resort then is redefining the whole function. However, it can break updated packages if something changes in the original function implementation.
Actually, same can sometimes happen with advises. Is there a way to deal with it?ENDEl-patch allow changing the whole function definition without a risk to break anything.
It warns me if the original definition changes from what I expect.
(use-package el-patch
:straight t
:demand t)Scripts
Set executable flag in all the script files
(when init-flag
;; stolen from https://github.com/jethrokuan/.emacs.d/blob/master/init.el
(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p))Gnuplot
(use-package gnuplot
:if (or init-flag org-export-flag)
:straight t
:mode ("\\.\\(gp\\|gnuplot\\|plot\\)$" . gnuplot-mode))Lua
(use-package lua-mode
:if init-flag
:straight t)Gentoo ebuilds
(use-package ebuild-mode
:if init-flag
:straight t)LaTeX
SOMEDAY [#A] revise config from here- State “SOMEDAY” from “HOLD” [2020-12-11 Fri 15:48]
- State “HOLD” from “DOING” [2020-05-13 Wed 21:56]
Later, when I do not have more important emacs things to do
- State “DONE” from “DOING” [2019-12-19 Thu 13:06]
Nowadays, I do not really write pure LaTeX, but rather use org-mode export. The below configuration is here just in case if I need to open and edit tex files for some reason.
Auctex
This is also required for cdlatex to work with org-mode.
(use-package latex
:if init-flag
:defer t
:straight auctex
:custom
(TeX-auto-save t)
(TeX-parse-self t))Use pdf-tools to view resulting pdf
(when init-flag
(setq TeX-view-program-list '(("pdf tools refresh" (lambda() (pdf-tools-install)
(TeX-pdf-tools-sync-view)))))
(setq TeX-view-program-selection '((output-pdf "pdf tools refresh")))
(setq TeX-source-correlate-start-server t))Ledger
(use-package ledger-mode
:if init-flag
:straight t
:bind (:map boon-goto-map
("z" . open-finance)
:map ledger-mode-map
("M-n" . nil)
("M-p" . nil)
("C-c C-a" . ledger-add-transaction-and-boonedit))
:config
(defun open-finance()
"Open ledger file."
(interactive)
(find-file "~/Finance/Singapore-PhD/Ledger.dat"))
(defun ledger-add-transaction-and-boonedit ()
"Switch to boon insert state when adding transaction."
(interactive)
(call-interactively 'ledger-add-transaction)
(boon-set-insert-like-state))
(setq ledger-reports
'(("bal" "ledger --pedantic -f %(ledger-file) bal not Equity")
("balsg" "ledger --pedantic -f %(ledger-file) bal not Equity -X S$")
("balusd" "ledger --pedantic -f %(ledger-file) bal not Equity -X $")
("balcny" "ledger --pedantic -f %(ledger-file) bal not Equity -X CNY")
("balall" "ledger --pedantic -f %(ledger-file) bal not Equity:Opening")
("reg" "ledger --pedantic --pending -f %(ledger-file) reg not Equity")
("payee" "ledger --pedantic -f %(ledger-file) reg @%(payee)")
("account" "ledger --pedantic -f %(ledger-file) reg %(account)")
("budget" "ledger --pedantic -f %(ledger-file) bal --budget")
("budgetcny" "ledger --pedantic -f %(ledger-file) bal --budget -X CNY")
("budgetsg" "ledger --pedantic -f %(ledger-file) bal --budget -X S$"))
ledger-report-auto-refresh t)
(use-package meta-functions
:config
(meta-defun meta-down-element :mode ledger-mode ledger-navigate-next-xact-or-directive)
(meta-defun meta-up-element :mode ledger-mode ledger-navigate-prev-xact-or-directive))
)Do not end the completions with string
(when init-flag
(add-hook 'ledger-mode-hook (lambda () (setq-local pcomplete-termination-string ""))))Complete in steps
(use-package ledger-mode
:if init-flag
:defer t
:config
(setq ledger-complete-in-steps t))Wolfram Mathematica
(use-package wolfram-mode
:if init-flag
:straight t
)Compressing too large pdfs
INPUT="$1"
if [[ ! -f "$INPUT" ]]; then
echo "File not exist \"$INPUT\""
exit 1
fi
OUTPUT="$2"
if [[ -f "$2" ]]; then
echo "File exists \"$2\""
exit 1
fi
OUTPUT=${OUTPUT:-${INPUT%.*}.pdf}
[[ $# > 2 ]] && (echo "Extra arguments found: \"$*\""; exit 1)
# gs -sDEVICE=pdfwrite -dCompatibilityLevel=1.4 -dPDFSETTINGS=/ebook -dNOPAUSE -dQUIET -dBATCH -sOutputFile="$OUTPUT" "$INPUT"
# gs -sDEVICE=pdfwrite -dCompatibilityLevel=1.4 -dPDFSETTINGS=/printer -dNOPAUSE -dQUIET -dBATCH -sOutputFile="$OUTPUT" "$INPUT"
gs -sDEVICE=pdfwrite -dCompatibilityLevel=1.4 -dPDFSETTINGS=/prepress -dNOPAUSE -dQUIET -dBATCH -sOutputFile="$OUTPUT" "$INPUT"Pdf view
(use-package pdf-tools
:if init-flag
:defer t
:straight (pdf-tools :type git :host github :repo "vedang/pdf-tools" :local-repo "~/Git/pdf-tools"
:fork (:host github
:repo "yantar92/pdf-tools"))
:custom
(pdf-view-colors 'default)
:magic ("%PDF" . pdf-view-mode)
:bind (:map pdf-view-mode-map
("v w" . pdf-view-fit-width-to-window)
("v h" . pdf-view-fit-height-to-window))
:init
(defun yant/pdf-view-down nil
"Go down document in pdf-view."
(interactive)
(pdf-view-next-line-or-next-page 5))
(defun yant/pdf-view-up nil
"Go up document in pdf-view."
(interactive)
(pdf-view-previous-line-or-previous-page 5))
:config
(pdf-tools-install)
(add-hook 'pdf-view-mode-hook #'pdf-view-fit-width-to-window 'APPEND)
(add-hook 'pdf-view-mode-hook #'pdf-tools-enable-minor-modes 'APPEND)
(use-package meta-functions
:config
(meta-defun meta-down :mode pdf-view-mode yant/pdf-view-down)
(meta-defun meta-up :mode pdf-view-mode yant/pdf-view-up)
(meta-defun meta-forward :mode pdf-view-mode (image-forward-hscroll 5))
(meta-defun meta-backward :mode pdf-view-mode (image-backward-hscroll 5))
(meta-defun meta-scroll-down :mode pdf-view-mode pdf-view-scroll-down-or-previous-page)
(meta-defun meta-scroll-up :mode pdf-view-mode pdf-view-scroll-up-or-next-page)
(meta-defun meta-down :mode pdf-annot-list-mode tablist-next-line)
(meta-defun meta-up :mode pdf-annot-list-mode tablist-previous-line)))Restore the last position in pdf
(use-package pdf-view-restore
:if init-flag
:straight t
:after pdf-tools
:config
(add-hook 'pdf-view-mode-hook 'pdf-view-restore-mode))Pdf rotate
(use-package pdf-tools
:if init-flag
:defer t
:init
(defun pdf-view--rotate (&optional counterclockwise-p page-p)
"Rotate PDF 90 degrees. Requires pdftk to work.\n
Clockwise rotation is the default; set COUNTERCLOCKWISE-P to
non-nil for the other direction. Rotate the whole document by
default; set PAGE-P to non-nil to rotate only the current page.
\nWARNING: overwrites the original file, so be careful!"
;; error out when pdftk is not installed
(if (null (executable-find "pdftk"))
(error "Rotation requires pdftk")
;; only rotate in pdf-view-mode
(when (eq major-mode 'pdf-view-mode)
(let* ((rotate (if counterclockwise-p "left" "right"))
(file (format "\"%s\"" (pdf-view-buffer-file-name)))
(page (pdf-view-current-page))
(pages (cond ((not page-p) ; whole doc?
(format "1-end%s" rotate))
((= page 1) ; first page?
(format "%d%s %d-end"
page rotate (1+ page)))
((= page (pdf-info-number-of-pages)) ; last page?
(format "1-%d %d%s"
(1- page) page rotate))
(t ; interior page?
(format "1-%d %d%s %d-end"
(1- page) page rotate (1+ page))))))
;; empty string if it worked
(if (string= "" (shell-command-to-string
(format (concat "pdftk %s cat %s "
"output %s.NEW "
"&& mv %s.NEW %s")
file pages file file file)))
(pdf-view-revert-buffer nil t)
(error "Rotation error!"))))))
(defun pdf-view-rotate-clockwise (&optional arg)
"Rotate PDF page 90 degrees clockwise. With prefix ARG, rotate
entire document."
(interactive "P")
(pdf-view--rotate nil (not arg)))
(defun pdf-view-rotate-counterclockwise (&optional arg)
"Rotate PDF page 90 degrees counterclockwise. With prefix ARG,
rotate entire document."
(interactive "P")
(pdf-view--rotate :counterclockwise (not arg))))Fix page number in boon mode-line when the pdf is opened in a new frame
It’s magic(use-package boon-powerline
:if init-flag
:defer t
:init
(use-package pdf-view
:defer t
:config
(setq pdf-cache-prefetch-delay 8)))Kill pdf buffer on q
(use-package pdf-tools
:if init-flag
:defer t
:config
(defun yant/kill-pdf-buffer-and-quit-window ()
"When in pdf-view-mode, kill the buffer and clear image cache.
See https://lists.gnu.org/archive/html/bug-gnu-emacs/2019-11/msg01731.html for details why clearing cache is useful."
(interactive)
(if (eq major-mode 'pdf-view-mode)
(progn
(quit-window 'kill)
(clear-image-cache t))
(funcall-interactively #'quit-window)))
(bind-key "q" #'yant/kill-pdf-buffer-and-quit-window pdf-view-mode-map))diffpdf
Requires app-text/diffpdf.
(use-package diffpdf
:if init-flag
:straight t)Ebook reader
(use-package ereader
:if init-flag
:straight t)Utils
Shell
Eterm
Eterm is a much faster version of terminal for emacs since utilising emacs library support.
(use-package vterm
:if init-flag
:straight t
:demand t
;;:straight (vterm :host github :repo "akermu/emacs-libvterm")
:commands (vterm vterm-other-window))
;; ;; directory tracking
;; (defun vterm--rename-buffer-as-title (title)
;; (let ((dir (string-trim-left (concat (nth 1 (split-string title ":")) "/"))))
;; (cd-absolute dir)
;; (rename-buffer (format "term %s" title) t)))
;; (add-hook 'vterm-set-title-functions 'vterm--rename-buffer-as-title)
;; ;; vterm toggle
;; (eval-when-compile
;; (quelpa '(vterm-toggle :fetcher github :repo "jixiuf/vterm-toggle")))
;; (use-package vterm-toggle
;; :ensure nil
;; :commands (vterm-toggle-forward vterm-toggle-backward vterm-toggle-cd vterm-toggle)
;; :config
;; (setq vterm-toggle-fullscreen-p nil)
;; ;; toggle window in bottom side
;; (add-to-list 'display-buffer-alist
;; '("^v?term.*"
;; (display-buffer-reuse-window display-buffer-at-bottom)
;; ;;(display-buffer-reuse-window display-buffer-in-direction)
;; ;;display-buffer-in-direction/direction/dedicated is added in emacs27
;; ;;(direction . bottom)
;; ;;(dedicated . t) ;dedicated is supported in emacs27
;; (reusable-frames . visible)
;; (window-height . 0.5))))Shell colours
(use-package eterm-256color
:if init-flag
:straight t
:hook
(term-mode-hook . eterm-256color-mode)
(vterm-mode-hook . eterm-256color-mode))Invocation
(use-package shell-pop
:if init-flag
:straight t
:bind ("M-<f9>" . shell-pop)
:init
(setq shell-pop-shell-type '("vterm" "*vterm*" (lambda () (vterm))))
(setq shell-pop-window-position "right")
:config
(shell-pop--set-shell-type 'shell-pop-shell-type shell-pop-shell-type))Interaction with boon
(use-package meta-functions
:if init-flag
:config
(use-package term
:config
(meta-defun meta-insert-enclosure-new-line :mode term-mode ignore)
(meta-defun meta-new-line :mode term-mode term-send-raw)))
Kill process buffer after finishing
(when init-flag
(defun jt-shell-sentinel (process event)
"Kill buffer and window on shell PROCESS termination when EVENT describe normal termination."
(when (and (not (process-live-p process))
(string-equal event "finished\n"))
(let ((buf (process-buffer process)))
(when (buffer-live-p buf)
(with-current-buffer buf
(kill-buffer)
(delete-window))))))
(add-hook 'shell-mode-hook (lambda () (set-process-sentinel (get-buffer-process (buffer-name) ) #'jt-shell-sentinel))))Calc
Command loop
Global bindings
(use-package calc
:if init-flag
:bind (:map boon-goto-map
("c" . calc)
("C" . calc-dispatch)))Do not evaluate expressions as much as possible (symbolic mode)
(setq calc-symbolic-mode t)Gnuplot integration
(use-package calc
:if init-flag
:config
(setq calc-gnuplot-default-device "qt"))Appearance
Render symbolic math in LaTeX using calctex-mode
(use-package calctex
:if init-flag
:straight (calctex :host github :repo "johnbcoughlin/calctex"
:files ("*.el" "calctex/*.el" "vendor/*"))
:commands calctex-mode
:init
(add-hook 'calc-mode-hook #'calctex-mode)
:config
;; Credit: https://tecosaur.github.io/emacs-config/config.html#calc-calctex
;; Fix hardcoded dvichop path (whyyyyyyy)
(let ((vendor-folder (concat (file-truename user-emacs-directory)
"straight/repos"
"/calctex/vendor/")))
(setq calctex-dvichop-sty (concat vendor-folder "texd/dvichop")
calctex-dvichop-bin (concat vendor-folder "texd/dvichop")))
(unless (file-exists-p calctex-dvichop-bin)
(message "CalcTeX: Building dvichop binary")
(let ((default-directory (file-name-directory calctex-dvichop-bin)))
(call-process "make" nil nil nil))))Extra customisation from [[id:de714e334e29b6ebfe88071cade9ecf618cfe342][tecosaur [Tecosaur.Github] (2021) Doom Emacs Configuration]]
(use-package calctex
:if init-flag
:config
(setq calctex-additional-latex-packages "
\\usepackage[usenames]{xcolor}
\\usepackage{soul}
\\usepackage{adjustbox}
\\usepackage{amsmath}
\\usepackage{amssymb}
\\usepackage{siunitx}
\\usepackage{cancel}
\\usepackage{mathtools}
\\usepackage{mathalpha}
\\usepackage{xparse}
\\usepackage{arevmath}"
calctex-additional-latex-macros
(concat calctex-additional-latex-macros
"\n\\let\\evalto\\Rightarrow")))Silence the calctex’s real-time LaTeX interpreter
Credit: [[id:de714e334e29b6ebfe88071cade9ecf618cfe342][tecosaur [Tecosaur.Github] (2021) Doom Emacs Configuration]]
(use-package calctex
:if init-flag
:config
(yant/advice-shut-up calctex-default-dispatching-render-process))Music
Mingus (mpd)
I usually run mingus in a new frame using global WM key binding.
Hence, delete frame instead of burying the mingus buffer.
(use-package mingus
:if init-flag
:straight t
:bind (:map mingus-playlist-map
("q" . (lambda() (interactive) (mingus-git-out) (delete-frame)))))When listening a new band/album, I usually go through all the songs and delete what I do no like until several song remain in the playlist. It is much more convenient to have a global command to delete currently playing song if I do not like it instead of opening mingus frame and doing it manually.
(use-package mingus
:defer t
:if init-flag
:config
(defun yant/mingus-delete-currently-playing ()
"Remove currently playing song from playlist."
(interactive)
(when (and (get-buffer "*Mingus*")
(mingus-cur-song-number))
(with-current-buffer "*Mingus*"
(mingus-goto-current-song)
(mingus-del)))))Boon special mode bindings
(use-package meta-functions
:if init-flag
:config
(meta-defun meta-move-line-down :mode mingus-playlist-mode mingus-move-down)
(meta-defun meta-move-line-up :mode mingus-playlist-mode mingus-move-up)
(meta-defun meta-new-line :mode mingus-playlist-mode mingus-play)
(meta-defun meta-new-line :mode mingus-browse-mode mingus-down-dir-or-play-song)
(meta-defun meta-up-element :mode mingus-browse-mode mingus-open-parent))Printing
(setq lpr-command "gtklp")
(setq lpr-add-switches "-C \"emacs-print\"")
(setq pdf-misc-print-programm "gtklp")
(setq pdf-misc-print-programm-args '("-C \"emacs-print\""))Calendar
Meta bindings for calendar(use-package calendar
:if init-flag
:requires meta-functions
:config
(meta-defun meta-down :mode calendar-mode calendar-forward-week)
(meta-defun meta-up :mode calendar-mode calendar-backward-week)
(meta-defun meta-forward :mode calendar-mode calendar-forward-day)
(meta-defun meta-backward :mode calendar-mode calendar-backward-day)
(meta-defun meta-down-element :mode calendar-mode calendar-forward-year)
(meta-defun meta-up-element :mode calendar-mode calendar-backward-year)
(meta-defun meta-forward-element :mode calendar-mode calendar-forward-month)
(meta-defun meta-backward-element :mode calendar-mode calendar-backward-month))Yaml
(use-package yaml-mode
:if init-flag
:straight t)Images
Viewing images in Emacs
(use-package image-mode
:if init-flag
:config
(meta-defun meta-down :mode image-mode image-next-file)
(meta-defun meta-up :mode image-mode image-previous-file))Screencasting
Record the screencast using emacs-gif-screencast.
Need to install gifsicle and scrot
(use-package gif-screencast
:if init-flag
:straight (gif-screencast :host gitlab :repo "ambrevar/emacs-gif-screencast")
:config
(setq gif-screencast-output-directory "~/Downloads/"))Show the key strokes.
(use-package keycast
:if init-flag
:straight t
:config
;; This is because I do not use mode line (it is set to "")
(setq keycast-insert-after "")
(setq mode-line-keycast-format "%k%c%r"))QR code generation via qrencode-el
(use-package qrencode
:if init-flag
:commands (qrencode-region qrencode-url-at-point)
:straight (qrencode-el :host github :repo "ruediger/qrencode-el"))News & email
Elfeed
(use-package elfeed
:if init-flag
:straight t
:bind (:map elfeed-search-mode-map
("q" . delete-frame)
("r" . elfeed-search-update--force)
("R" . elfeed-search-fetch)
("t" . elfeed-search-untag-all-unread)
("T" . elfeed-search-tag-all-unread)
("b" . yant/elfeed-capture-entry)
("<tab>" . elfeed-quick-peek-current-item)
("B" . (lambda () (interactive)
(elfeed-search-tag-all 'opened)
(meta-up)
(elfeed-search-browse-url))))
:config
(use-package quick-peek
:straight t
:demand t
:init
(defun elfeed-quick-peek-current-item ()
"Show quick peek of current elfeed item or hide if one is already shown."
(interactive)
(require 'elfeed-show)
(let* ((entry (elfeed-search-selected :ignore-region))
(text (and entry
(with-temp-buffer
(elfeed-show-mode)
(setq elfeed-show-entry entry)
(elfeed-show-refresh)
(read-only-mode -1)
(setq-local fill-column 120)
(fill-region (point-min) (point-max) 'center)
(buffer-string)))))
(unless (> (quick-peek-hide (point)) 0)
(when text (quick-peek-show text nil nil)))))
(define-advice elfeed-search-untag-all-unread (:after (&rest args) hide-quickpeek)
"Hide all quick peek overlays in buffer."
(quick-peek-hide))
(advice-add 'yant/elfeed-capture-entry :after #'elfeed-search-untag-all-unread@hide-quickpeek)
(add-hook 'elfeed-search-update-hook #'elfeed-search-untag-all-unread@hide-quickpeek))
(use-package org-capture-pop-frame
:defer t
:config
(define-advice ocpf--org-capture (:around (old-fun orig-fun &optional goto keys) suppress-pop-frame-maybe)
"Suppress pop-up frame when ``yant/suppress-pop-frame'' is non nil."
(if (or (bound-and-true-p yant/suppress-pop-frame)
;; not doing the following check not only makes a frame appear
;; shortly, but also assigns header text to random other frame
(member :immediate-finish (assoc keys org-capture-templates)))
(funcall orig-fun goto keys)
(funcall old-fun orig-fun goto keys))))
(defun yant/elfeed-capture-entry ()
"Capture selected entries into inbox."
(interactive)
(elfeed-search-tag-all 'opened)
(meta-up)
(let ((entries (elfeed-search-selected)))
(cl-loop for entry in entries
do (elfeed-untag entry 'unread)
when (elfeed-entry-link entry)
do (cl-letf (((symbol-function 'raise-frame) (lambda (&rest _) nil)))
(let ((yant/suppress-pop-frame t)
;; (content (elfeed-deref (elfeed-entry-content entry)))
;; (content-type (elfeed-entry-content-type entry))
)
;; (setq content-text (with-temp-buffer (when content
;; (if (eq content-type 'html)
;; (elfeed-insert-html content)
;; (insert content)))
;; (let ((org-babel-min-lines-for-block-output 0)) ;; handle org-mode syntax in body
;; (org-escape-code-in-region (point-min) (point-max)))
;; (unless (string-empty-p (buffer-string))
;; (goto-char (point-min))
;; (insert "#+begin_src org\n\n")
;; (goto-char (point-max))
;; (insert "\n\n#+end_src"))
;; (buffer-string)))
(org-protocol-capture (list :template "B"
:url it
:title (format "%s: %s"
(elfeed-feed-title (elfeed-entry-feed entry))
(elfeed-entry-title entry))
:elfeed-data entry
;; :body content-text
)))))
(mapc #'elfeed-search-update-entry entries)
(unless (use-region-p) (forward-line))))
(setq elfeed-sort-order 'ascending)
(setq elfeed-search-title-max-width 150)
(setq elfeed-search-date-format '("%d %b, %a, %H:%M" 20 :left))
(unless (boundp 'elfeed-search-mode-hook) (setq elfeed-search-mode-hook nil))
;; (add-hook 'elfeed-search-mode-hook (lambda () (toggle-truncate-lines +1)))
(use-package elfeed-org
:straight t
;; I do not want my rss list to be in .emacs.d/var directory
:requires no-littering
:after elfeed
:config
(elfeed-org)
(setq rmh-elfeed-org-files (list "~/Org/rss.org"))))It is very hard to look through many new rss entries when entries from different feeds/topics are mixed. I constantly need to switch my focus thinking about different topics, which makes going through news feeds extremely slow.
To mitigate the issue, I prefer to group the feeds by similar topic, so that I can quickly decide what feeds I want to capture. The grouping can be done by progressive search filter, like +unread -topic1 -topic2 -topic3 .... I can simply edit the filter and remove last keyword one by one thus going through the new feeds topic-by-topic.
Similar idea: [[id:36ba1ec888a75c0461e9eeb1cf2fe8c7747ed7bd][Álvaro Ramírez [Xenodium] (2018) Quickly swapping elfeed filters]]
(use-package elfeed-search
:after elfeed
:config
(defvar elfeed-search-default-filter "+unread -hide @2month -video -general_science -science -course -chinese -emacs +jobs"
"Default filter in elfeed search window.")
(setq elfeed-search-filter elfeed-search-default-filter)
(define-advice elfeed-search-live-filter (:around (oldfun &optional arg) default-filter-maybe)
"Set `elfeed-search-filter' to `elfeed-search-default-filter' when invoked with C-u prefix argument."
(interactive "P")
(setq elfeed-search-filter (if arg elfeed-search-default-filter elfeed-search-filter))
(call-interactively oldfun)))Sort entries by Gnus-like score
(use-package elfeed-score
:if init-flag
:straight t
:after elfeed
:config
(elfeed-score-enable nil)
(define-key elfeed-search-mode-map "=" elfeed-score-map))And group them by rss feed, which further helps to focus on a single topic at a time.
(use-package elfeed-score
:config
(defun yant/elfeed-group-by-feed (entry1 entry2)
(let ((time1 (elfeed-entry-date entry1))
(time2 (elfeed-entry-date entry2))
(rss1 (elfeed-entry-feed-id entry1))
(rss2 (elfeed-entry-feed-id entry2)))
(or (string> rss1 rss2)
(and (string= rss1 rss2)
(> time1 time2)))))
(setf elfeed-search-sort-function (lambda (a b)
(let ((scorea (elfeed-score-scoring-get-score-from-entry a))
(scoreb (elfeed-score-scoring-get-score-from-entry b)))
(or (< scorea scoreb)
(and (= scorea scoreb)
(yant/elfeed-group-by-feed a b)))))))Save elfeed buffer on quit to make sure that database is more likely saved if Emacs crashes. [2020-09-18 Fri] Disabling because of large memory usage
(use-package elfeed
:if init-flag
:after elfeed
:config
(defun yant/elfeed-save-and-quit ()
"Save elfeed database and quit."
(interactive)
(elfeed-db-save-safe)
(delete-frame))
(bind-key "q" #'yant/elfeed-save-and-quit elfeed-search-mode-map))Custom title formatting
Default elfeed format function does not remove things like \mathrm (or similar) from titles. I am doing it in the following function.
In addition, I highlight some noteworthy phrases to simplify scanning through the feeds.
(use-package elfeed
:init
(defvar yant/elfeed-title-transforms `(("\\\\mathrm{\\([^}]+\\)}" "\\1")
("\\$\\([^$]+\\)\\$" "\\1")
("<em>\\(.+?\\)</em>" "\\1")
("<" "<")
("<math xmlns:mml=\"http://www\\.w3\\.org/1998/Math/MathML\" altimg=\"si[0-9]+\\.svg\" class=\"math\">\\(.+?\\)</math>" "\\1")
("<mover accent=\"true\">\\(.+?\\)</mover>" "\\1")
("<mrow>\\(.*?\\)</mrow>" "\\1")
("<mn>\\(.*?\\)</mn>" "\\1")
("<mo>\\(.*?\\)</mo>" "\\1")
("<msub>\\(.+?\\)</msub>" "\\1" (display ,(car org-script-display)))
("_\\([^{]\\)" "\\1" (display ,(car org-script-display)))
("_{\\([^}]+\\)}" "\\1" (display ,(car org-script-display)))
("<sub>\\(.+?\\)</sub>" "\\1" (display ,(car org-script-display)))
("\\^\\([^{]\\)" "\\1" (display ,(cadr org-script-display)))
("\\^{\\([^}]+\\)}" "\\1" (display ,(cadr org-script-display)))
("<sup>\\(.+?\\)</sup>" "\\1" (display ,(cadr org-script-display)))
("<msup>\\(.+?\\)</msup>" "\\1" (display ,(cadr org-script-display)))
("<i>\\(.+?\\)</i>" "\\1" (face (:slant italic)))
("<mi>\\(.+?\\)</mi>" "\\1" (face (:slant italic)))
("{\\([^}]+\\)}" "\\1")
("[Aa]nisotro[^ ]+" "\\&" (face (:foreground "red")))
("[^ ]*laminate[^ ]*" "\\&" (face (:foreground "red")))
("[Oo]ligo[^ ]*" "\\&" (face (:foreground "red")))
("[Bb]oundar[^ ]*" "\\&" (face (:foreground "red")))
("[Ss]ynchrotron" "\\&" (face (:foreground "red")))
("[Ii]nterfac[^ ]+" "\\&" (face (:foreground "red")))
("[Ll]ayer[^ ]+" "\\&" (face (:foreground "red")))
("[Mm]icro-cantilever[^ ]*" "\\&" (face (:foreground "red")))
("[Pp]illar" "\\&" (face (:foreground "red")))
("[Cc]antilever" "\\&" (face (:foreground "red")))
("[Ii]n.situ" "\\&" (face (:foreground "red")))
("M[m]g[0-9]*[-/]*[Aa]l[0-9]*" "\\&" (face (:foreground "red")))
("[Mm]ulti-?layer" "\\&" (face (:foreground "red")))
("[Nn]ano-?layer" "\\&" (face (:foreground "red")))
("[Hh]igh[ -][Ee]ntropy" "\\&" (face (:foreground "red")))
("[Mm]edium[ -][Ee]ntropy" "\\&" (face (:foreground "red")))
("[Mm]agnesium" "\\&" (face (:foreground "red")))
("[Mm]g" "\\&" (face (:foreground "red")))
("[Cc]rack[^ ]*" "\\&" (face (:foreground "red"))))
"Replacements to be performed in the elfeed entry titles.")
(defun yant/elfeed-search-print-entry (entry)
"Print ENTRY to the buffer."
(let* ((date (elfeed-search-format-date (elfeed-entry-date entry)))
(score (elfeed-meta entry :elfeed-score/score))
(title (if (elfeed-tagged-p 'content_is_entry entry)
(elfeed-deref (or (elfeed-meta entry :content) (elfeed-entry-content entry) ""))
(or (elfeed-meta entry :title) (elfeed-entry-title entry) "")))
(title-faces (elfeed-search--faces (elfeed-entry-tags entry)))
(title (if (and (elfeed-tagged-p 'chinese entry)
(member (yant/guess-language-string title) '("zh-cn" "ko")))
(progn (message "Translating...")
(with-temp-buffer
(insert (yant/translate-string title))
(add-face-text-property (point-min) (point-max) title-faces 'append)
(buffer-string)))
(with-temp-buffer
(insert title)
(cl-loop for (re repl display)
in yant/elfeed-title-transforms
do
(goto-char (point-min))
(while (re-search-forward re nil t)
(replace-match repl)
(when display
(with-silent-modifications
(apply #'put-text-property
(match-beginning 0)
(match-end 0)
display)))))
(add-face-text-property (point-min) (point-max) title-faces 'append)
(buffer-string))))
(feed (elfeed-entry-feed entry))
(feed-title
(when feed
(or (elfeed-meta feed :title) (elfeed-feed-title feed))))
(tags (mapcar #'symbol-name (elfeed-entry-tags entry)))
(tags-str (mapconcat
(lambda (s) (propertize s 'face 'elfeed-search-tag-face))
tags ","))
(title-width (- (window-width) 10 elfeed-search-trailing-width))
(title-column (elfeed-format-column
title (elfeed-clamp
elfeed-search-title-min-width
title-width
elfeed-search-title-max-width)
:left)))
;; (insert (propertize date 'face 'elfeed-search-date-face) " ")
(insert (propertize (format "%-3d" score) 'face 'elfeed-search-date-face) " ")
(insert (propertize title-column 'kbd-help title) " ")
(when feed-title
(insert (propertize feed-title 'face 'elfeed-search-feed-face) " "))
(when tags
(insert "(" tags-str ")"))))
(setq elfeed-search-print-entry-function #'yant/elfeed-search-print-entry))
Highlight FLAGGED feed entries
(use-package elfeed
:config
(setf (alist-get 'flagged elfeed-search-face-alist) `((t :weight semibold :foreground "red" :background ,(color-darken-name (face-background 'default) 10))))
(setf (alist-get 'FLAGGED elfeed-search-face-alist) `((t :weight semibold :foreground "red" :background ,(color-darken-name (face-background 'default) 10)))))Notmuch
I was using notmuch-tree-mode for a while, but find it not very comfortable. Especially in threads with many small messages, which could otherwise appear all together in notmuch-show-mode. Can be still occasionally useful to navigate the complicated threads though.
(use-package notmuch
:straight t
:commands (notmuch notmuch-search)
:config
(use-package boon
:if init-flag
:config
(defun yant/notmuch-show-view-part ()
"Search and open part at point or html part of the message."
(interactive)
(save-excursion
(beginning-of-line)
(if (looking-at "^[ ]*\\[[^\\[]+]$")
(notmuch-show-view-part)
(beginning-of-buffer)
(re-search-forward "text/html")
(notmuch-show-view-part))))
(use-package meta-functions
:config
;; consider notmuch-tree-to-message-pane to run functions in message pane
(meta-defun meta-scroll-up :mode notmuch-tree-mode scroll-other-window)
(meta-defun meta-scroll-down :mode notmuch-tree-mode scroll-other-window-down)
(meta-defun meta-recenter-top-bottom :mode notmuch-tree-mode (with-selected-window (other-window-for-scrolling) (recenter-top-bottom)))
(meta-defun meta-new-line :mode notmuch-tree-mode (if notmuch-tree-message-window (notmuch-tree-show-message-out) (notmuch-tree-show-message-in)))
(meta-defun meta-down :mode notmuch-tree-mode (progn
(notmuch-tree-next-matching-message)
(unless (notmuch-tree-get-message-id)
(notmuch-tree-prev-matching-message))))
(meta-defun meta-up :mode notmuch-tree-mode (progn
(notmuch-tree-prev-matching-message)
(unless (notmuch-tree-get-message-id)
(notmuch-tree-next-matching-message))))
(meta-defun meta-down-element :mode notmuch-tree-mode notmuch-tree-next-message)
(meta-defun meta-up-element :mode notmuch-tree-mode notmuch-tree-prev-message)
(meta-defun meta-down :mode notmuch-search-mode notmuch-search-next-thread)
(meta-defun meta-up :mode notmuch-search-mode notmuch-search-previous-thread)
(meta-defun meta-down-element :mode notmuch-search-mode notmuch-search-show-thread)
(meta-defun meta-up-element :mode notmuch-search-mode ignore)
(meta-defun meta-down-element :mode notmuch-show-mode (notmuch-show-next-message))
(meta-defun meta-up-element :mode notmuch-show-mode (notmuch-show-previous-message)))
(defun notmuch-tree-close-and-quit ()
"Close the current message in notmuch-tree and quit the tree buffer."
(interactive)
(notmuch-tree-close-message-window)
(kill-buffer (current-buffer)))
(defun notmuch-show-close-and-quit-tree-maybe ()
"Close the current message in `notmuch-show-mode' and also close
the notmuch-tree buffer if it appears after closing the message."
(interactive)
(notmuch-bury-or-kill-this-buffer)
(when (eq major-mode 'notmuch-tree-mode)
(notmuch-tree-close-and-quit)))
(defun notmuch-tree-from-search-thread-and-focus-on-message ()
"Switch to tree view of the thread at point and activate the message window."
(interactive)
(notmuch-tree-from-search-thread)
(other-window 1)
;; Open full message in single-message thread.
(sit-for 0.1)
(while (not (save-excursion (goto-char 1) (re-search-forward "^End of search results.$" nil t))) (sleep-for 0.1))
(when (= 2 (count-lines (point-min) (point-max)))
(notmuch-tree-show-message-out)))
(bind-keys :map notmuch-search-mode-map
("r" . notmuch-refresh-this-buffer)
("C-c C-u" . notmuch-search-unread)
("C-c C-d" . notmuch-search-done)
("C-c C-a" . notmuch-search-hide)
("C-c C-f" . notmuch-search-nolist)
("C-c C-S-d" . notmuch-search-delete)
("<RET>" . notmuch-tree-from-search-thread-and-focus-on-message)
:map notmuch-show-mode-map
("q" . notmuch-show-close-and-quit-tree-maybe)
("v" . yant/notmuch-show-view-part)
("J" . notmuch-show-next-message)
("K" . notmuch-show-previous-message)
("C-c C-u" . notmuch-show-unread)
("C-c C-d" . notmuch-show-done)
("C-c C-a" . notmuch-show-hide)
("C-c C-f" . notmuch-show-nolist)
("C-c C-S-d" . notmuch-show-delete)
:map notmuch-tree-mode-map
("v" . (lambda () (interactive) (if (window-live-p notmuch-tree-message-window)
(with-selected-window notmuch-tree-message-window
(yant/notmuch-show-view-html-part)))))
("q" . notmuch-tree-close-and-quit)
("C-c C-u" . notmuch-tree-unread)
("C-c C-d" . notmuch-tree-done)
("C-c C-a" . notmuch-tree-hide)
("C-c C-f" . notmuch-tree-nolist)
("C-c C-S-d" . notmuch-tree-delete))))Sendmail setup
- multiple accounts
(setq send-mail-function 'sendmail-send-it) ;;autochoose account name for msmtp (defun cg-feed-msmtp () (if (message-mail-p) (save-excursion (let* ((from (save-restriction (message-narrow-to-headers) (message-fetch-field "from"))) (account (cond ;; I use email address as account label in ~/.msmtprc ((string-match "yantar92@gmail.com" from) "yantar92@gmail.com") ((string-match "ihor_radchenko@alumni.sutd.edu.sg" from) "ihor_radchenko@alumni.sutd.edu.sg")))) (setq message-sendmail-extra-arguments (list '"-a" account)))))) ; the original form of this script did not have the ' before "a" which causes a very difficult to track bug --frozencemetery (add-hook 'message-send-mail-hook 'cg-feed-msmtp) (setq message-sendmail-envelope-from 'header) (setq mail-specify-envelope-from 't) (setq mail-envelope-from 'header) (setq message-make-forward-subject-function 'message-forward-subject-fwd) (setq notmuch-fcc-dirs '(("ihor_radchenko@alumni.sutd.edu.sg" . "Office365/Sent +sent -unread") ("yantar92@gmail.com" . "Gmail/Sent +sent -unread")))
- automatic email signing
I have to skip signing for some email accounts, because the server appends some text to messages. Even though the resulting message is correct, but some email clients are not able to open these messages properly. They show the appended text and unreadable attachment.
(setq mml-default-sign-method "pgp") (setq notmuch-crypto-process-mime t) (defvar yant/mml-do-not-sign-accounts-list '("ihor_radchenko@alumni.sutd.edu.sg" "yantar92@gmail.com") "List of accounts, where the messaged should not be signed.") (defun yant/mml-secure-message-sign-pgpmime-maybe () "Sign the message unless the sending account is in `yant/mml-do-not-sign-accounts-list'." (let ((from (save-restriction (message-narrow-to-headers) (message-fetch-field "from")))) (unless (-first (lambda (el) (string-match el from)) yant/mml-do-not-sign-accounts-list) (mml-secure-message-sign-pgpmime)))) (add-hook 'message-send-hook #'yant/mml-secure-message-sign-pgpmime-maybe)
- async mail sending
;; (use-package async
;; :if init-flag
;; :straight t
;; :config
;; (use-package smtpmail-async
;; :config
;; (setq message-send-mail-function 'message-send-mail-with-sendmail)))Tagging of sent messages
(use-package notmuch
:if init-flag
:defer t
:config
(unbind-key "C-c C-s" notmuch-message-mode-map)
(bind-key "C-c C-c"
(lambda()
(interactive)
(notmuch-mua-send-and-exit)
(start-process "Update tags"
nil
"notmuch-new-messages-list.sh"))
notmuch-message-mode-map))Tagging functions
(use-package notmuch
:if init-flag
:after notmuch
:config
(defun notmuch-show-delete ()
(interactive)
(let ((tags (seq-remove (lambda (el) (string-match-p "[0-9]\\{4\\}" el)) ; remove year tags
(seq-difference (notmuch-show-get-tags) '("inbox" "todo" "attachment" "sent" "unread" "spam" "spam_server" "maillist" "deleted")))))
(when (or (member "listinbox" tags)
(seq-empty-p tags)
(yes-or-no-p "Really delete?"))
(notmuch-show-tag-message "+deleted" "-inbox" "-todo" "-listinbox"))))
(defun notmuch-show-unread()
(interactive)
(notmuch-show-tag-message "+unread"))
(defun notmuch-show-nolist()
(interactive)
(notmuch-show-tag-message "+inbox" "-listinbox" "+nolist"))
(defun notmuch-show-done()
(interactive)
(notmuch-show-tag-message "-todo" "-inbox" "-listinbox"))
(defun notmuch-show-hide()
(interactive)
(notmuch-show-tag-message "-todo"))
(defun notmuch-tree-unread()
(interactive)
(notmuch-tree-tag '("+unread")))
(defun notmuch-tree-nolist()
(interactive)
(notmuch-tree-tag '("+inbox \"-listinbox\"") "+nolist"))
(defun notmuch-tree-done()
(interactive)
(notmuch-tree-tag '("-todo" "-inbox" "-listinbox")))
(defun notmuch-tree-hide()
(interactive)
(notmuch-tree-tag '("-todo")))
(defun notmuch-tree-delete()
(interactive)
(let ((tags (seq-remove (lambda (el) (string-match-p "[0-9]\\{4\\}" el)) ; remove year tags
(seq-difference (notmuch-tree-get-tags) '("inbox" "todo" "attachment" "sent" "unread" "spam" "spam_server" "maillist" "deleted")))))
(when (or (member "listinbox" tags)
(seq-empty-p tags)
(yes-or-no-p "Really delete?"))
(notmuch-tree-tag '("+deleted" "-inbox" "-todo" "-listinbox")))))
(defun notmuch-search-hide()
(interactive)
(notmuch-search-tag '("-todo")))
(defun notmuch-search-delete ()
(interactive)
(let ((tags (seq-remove (lambda (el) (string-match-p "[0-9]\\{4\\}" el)) ; remove year tags
(seq-difference (notmuch-search-get-tags) '("inbox" "todo" "attachment" "sent" "unread" "spam" "spam_server" "maillist" "deleted")))))
(when (or (member "listinbox" tags)
(seq-empty-p tags)
(yes-or-no-p "Really delete?"))
(notmuch-search-tag '("+deleted" "-inbox" "-todo" "-listinbox")))))
(defun notmuch-search-unread()
(interactive)
(notmuch-search-tag '("+unread")))
(defun notmuch-search-done()
(interactive)
(notmuch-search-tag '("-todo" "-inbox" "-listinbox")))
(defun notmuch-search-nolist()
(interactive)
(notmuch-search-tag '("+inbox" "-listinbox" "+nolist"))))Quit frame instead of bury buffer
(use-package notmuch
:if init-flag
:defer t
:config
(defvar-local notmuch-frame nil
"Non nil means that frame was invoked from system (not from inside emacs).")
(defadvice notmuch-refresh-this-buffer (around update-notmuch-frame activate)
"Preserve `notmuch-frame' value after refresh."
(let ((notmuch-frame-old notmuch-frame))
ad-do-it
(setq notmuch-frame notmuch-frame-old)))
(bind-key "q" (lambda()
(interactive)
(if notmuch-frame
(delete-frame)
(notmuch-bury-or-kill-this-buffer)))
notmuch-search-mode-map))Inline display
- inline view
- html renderer
I am using w3m as rendered. It should also be installed in the system.
(use-package w3m
:straight t
:commands w3m)
(when init-flag
(custom-set-variables
'(mm-external-terminal-program "kitty")
'(mm-inline-large-images-proportion 0.4)
'(mm-inline-media-tests
(quote
(("image/p?jpeg" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote jpeg)
handle)))
("image/png" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote png)
handle)))
("image/gif" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote gif)
handle)))
("image/tiff" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote tiff)
handle)))
("image/xbm" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote xbm)
handle)))
("image/x-xbitmap" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote xbm)
handle)))
("image/xpm" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote xpm)
handle)))
("image/x-xpixmap" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote xpm)
handle)))
("image/bmp" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote bmp)
handle)))
("image/x-portable-bitmap" mm-inline-image
(lambda
(handle)
(mm-valid-and-fit-image-p
(quote pbm)
handle)))
("text/plain" mm-inline-text identity)
("text/enriched" mm-inline-text identity)
("text/richtext" mm-inline-text identity)
("text/x-patch" mm-display-patch-inline identity)
("text/x-diff" mm-display-patch-inline identity)
("application/emacs-lisp" mm-display-elisp-inline identity)
("application/x-emacs-lisp" mm-display-elisp-inline identity)
("application/x-shellscript" mm-display-shell-script-inline identity)
("application/x-sh" mm-display-shell-script-inline identity)
("text/x-sh" mm-display-shell-script-inline identity)
("application/javascript" mm-display-javascript-inline identity)
("text/dns" mm-display-dns-inline identity)
("text/x-org" mm-display-org-inline identity)
("text/html" mm-inline-text-html
(lambda
(handle)
mm-text-html-renderer))
("text/x-vcard" mm-inline-text-vcard
(lambda
(handle)
(or
(featurep
(quote vcard))
(locate-library "vcard"))))
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
("message/partial" mm-inline-partial identity)
("message/external-body" mm-inline-external-body identity)
("text/.*" mm-inline-text identity)
("application/x-.?tar\\(-.*\\)?" ignore identity)
("application/zip" ignore identity)
("audio/wav" mm-inline-audio
(lambda
(handle)
(and
(or
(featurep
(quote nas-sound))
(featurep
(quote native-sound)))
(device-sound-enabled-p))))
("audio/au" mm-inline-audio
(lambda
(handle)
(and
(or
(featurep
(quote nas-sound))
(featurep
(quote native-sound)))
(device-sound-enabled-p))))
("application/pgp-signature" ignore identity)
("application/x-pkcs7-signature" ignore identity)
("application/pkcs7-signature" ignore identity)
("application/x-pkcs7-mime" ignore identity)
("application/pkcs7-mime" ignore identity)
("multipart/alternative" ignore identity)
("multipart/mixed" ignore identity)
("multipart/related" ignore identity)
("image/.*" mm-inline-image
(lambda
(handle)
(and
(mm-valid-image-format-p
(quote imagemagick))
(mm-with-unibyte-buffer
(mm-insert-part handle)
(let
((image
(ignore-errors
(if
(fboundp
(quote create-image))
(create-image
(buffer-string)
(quote imagemagick)
(quote data-p))
(mm-create-image-xemacs
(mm-handle-media-subtype handle))))))
(when image
(setcar
(cdr handle)
(list "image/imagemagick"))
(mm-image-fit-p handle)))))))
("audio/.*" ignore ignore)
("image/.*" ignore ignore)
(".*" mm-inline-text mm-readable-p))))
'(mm-inlined-types
(quote
("text/calendar" "image/.*" "text/.*" "message/delivery-status" "message/rfc822" "message/partial" "message/external-body" "application/emacs-lisp" "application/x-emacs-lisp" "application/pgp-signature" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime" "application/pgp")))
'(mm-text-html-renderer (quote w3m))
'(send-mail-function (quote sendmail-send-it))
)
(setq mm-text-html-renderer-alist '((shr . mm-shr)
(w3 . mm-inline-text-html-render-with-w3)
(w3m . mm-inline-text-html-render-with-w3m)
(w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
(gnus-w3m . gnus-article-html)
(links mm-inline-render-with-file mm-links-remove-leading-blank "links" "-dump" file)
(lynx mm-inline-render-with-stdin nil "qutebrowser-call.sh")
(html2text mm-inline-render-with-function html2text)))
;; Inline images?
(setq mm-attachment-override-types '("image/.*"))
;; No HTML mail
(setq mm-discouraged-alternatives '("text/html" "text/richtext" "text/rtf" "application/zip" "image/vnd.djvu" "application/x-dvi" "application/postscript" ))
;; Don't start a browser for text/html only mail
(setq mm-automatic-display
'("text/plain" "text/enriched"
"image/.*" "message/delivery-status" "message/rfc822"
"text/x-patch" "application/pgp-signature" "application/emacs-lisp"))
(setq mm-inline-large-images 'resize))Opening parts of messages in external programs (via mailcap)
text/html; qutebrowser-call.sh %s
text/*; xdg-open "%s"
application/*; xdg-open "%s"
video/*; xdg-open "%s"
image/*; xdg-open "%s"
Notmuch hello
(when init-flag
(setq notmuch-hello-sections '(notmuch-hello-insert-header notmuch-hello-insert-saved-searches
notmuch-hello-insert-alltags)
notmuch-saved-searches '((:name "todo" :query "tag:todo and tag:inbox" :sort-order newest-first)
(:name "work" :query "tag:todo or tag:inbox and not tag:private" :sort-order newest-first)
(:name "inbox" :query "tag:inbox" :key "i" :sort-order newest-first)
(:name "all mail" :query "*" :key "a"))))Interaction with org
Capture mail to org task
Capture using [[id:ddea3223-515c-4af1-bfc6-49174ce8bd27][yantar92 [Github] yantar92/org-capture-ref: Extract metadata/bibtex info from captured websites]]
(use-package notmuch
:if init-flag
:defer t
:config
(use-package org-capture-ref
:load-path "~/Git/org-capture-ref/"
:after org-ref
:init
(bind-key "t" 'org-capture-ref-capture-at-point notmuch-show-mode-map)
(bind-key "t" 'org-capture-ref-capture-at-point notmuch-search-mode-map)
(bind-key "t" 'org-capture-ref-capture-at-point notmuch-tree-mode-map)))Hide the captured emails away from the inbox
(use-package org-capture-ref
:if init-flag
:load-path "~/Git/org-capture-ref/"
:after (notmuch org-ref)
:config
(defun yant/org-remove-heading-email-from-inbox ()
"Remove email or thread associated with heading at point from notmuch inbox."
(when-let* ((link (org-entry-get nil "LINK"))
(link (save-match-data
(and (string-match "notmuch:\\(.+\\)" link)
(match-string-no-properties 1 link)))))
(let ((track? (string-match-p "notmuch:thread" link)))
(call-process notmuch-command nil nil nil "tag" (if track? "+track" "") "-todo" "-inbox" "-listinbox" "--" link))))
(add-hook 'org-capture-before-finalize-hook #'yant/org-remove-heading-email-from-inbox))Org mode functionality when writing messages
- State “TODO” from [2018-09-06 Thu 10:11]
Use footnote mode in emails
(use-package footnote
:if init-flag
:hook (message-mode . footnote-mode)
:init
(setq footnote-prefix [(control ?c) ?f]))Faster address completion
Tip from [[id:notmuchmail_2019_emacs][[notmuchmail] (2019) Emacstips]] Using [[id:github_aperezdc_aperez_notmuc_addrl_c_addres][aperezdc [Github] Aperezdc Notmuch-Addrlookup-C: Address Lookup Tool for Notmuch in C Using Glib and Libnotmuch]]
(use-package notmuch-address
:after notmuch
:if init-flag
:config
(setq notmuch-address-command "~/bin/notmuch-addrlookup"))Appearance
Message header face
(use-package message
:custom-face
(notmuch-message-summary-face ((t (:foreground ,(face-foreground 'header-line))))))Show accept/decline buttons for calendar invitations
(use-package notmuch
:if init-flag
:defer t
:config
(use-package notmuch-calendar-x
:straight (notmuch-calendar-x :local-repo "~/Git/notmuch-calendar-x")))Removing unreadable symbols from messages
Some email clients add unreadable symbols like into text version of the message. These symbols clutter the text and make it hard to read. So, it is better to remove/replace them altogether.
(use-package notmuch
:if init-flag
:defer t
:config
(defvar yant/notmuch-show-repl-regexps '((" ?" . "")
("\n\n\n+" . "\n\n"))
"List of regexps to remove or conses (regexp . replacement) to replace
in message body.")
(defun yant/notmuch-show-remove-all-regexs ()
"Remove/replace all regexps from message body as defined in `yant/notmuch-show-repl-regexps'."
(dolist (el
(mapcar (lambda (el)
(pcase el
((pred stringp) (list el))
(`(,(and (pred stringp) regex)
.
,(and (pred stringp) repl))
(list regex repl))
(_ (user-error "Invalid element of `yant/notmuch-show-repl-regexps': %S" el))))
yant/notmuch-show-repl-regexps))
(apply #'yant/notmuch-show-remove-regex el)))
(defun yant/notmuch-show-remove-regex (regex &optional replacement)
"Remove text matching REGEX from message body or replace it with REPLACEMENT."
(let ((inhibit-read-only t))
(message-goto-body)
(while (re-search-forward regex nil t)
(if replacement
(replace-match replacement)
(replace-match "")))))
(add-hook 'notmuch-show-hook #'yant/notmuch-show-remove-all-regexs))Message verification before sending
Check message body if there should be attachment and warn me if the actual attachment is missing
(use-package notmuch
:if init-flag
:defer t
:config
(add-hook 'notmuch-mua-send-hook #'notmuch-mua-attachment-check))Remind me about adding Woof headers when sending messages to org-mode maillist
Making sure to conform to Bastein’s request asking to use Woof conventions when sending emails. [[id:74d229fc782c20a7f32a04f07863af51598994b5][[Github] woof: Watch Over Our Folders]]
(use-package notmuch
:if init-flag
:defer t
:config
(defun yant/notmuch-mua-woof-check-maybe ()
"Remind to use Woof headers when sending email to org-mode maillist."
(let ((case-fold-search t))
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^\\(To:\\|Cc:\\).+emacs-orgmode@gnu\\.org" nil t)
(goto-char (point-min))
(unless (re-search-forward "^X-Woof-\\(Bug\\|Help\\|Change\\|Release\\|Patch\\):" nil t)
(unless (yes-or-no-p "No Woof-(Bug|Help|Patch): t/nil headers found in message being sent to emacs-orgmode@gnu.org. Send anyway? ")
(error "Forgot Woof headers")))))))
(add-hook 'notmuch-mua-send-hook #'yant/notmuch-mua-woof-check-maybe))Remind me to cut the auto-cited thread below email when replying to org-mode list
As recommended in Worg:List Etiquette
(use-package notmuch
:if init-flag
:defer t
:config
(defun yant/notmuch-mua-too-long-cite-reminder ()
"Remind to cut unnecessary thread citation when replying to orgmode."
(let ((case-fold-search t))
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^\\(To:\\|Cc:\\).+emacs-orgmode@gnu\\.org" nil t)
(message-goto-body)
(when (> (- (point-max) (point)) 5000) ; Message too long.
(unless (yes-or-no-p "Message is too long. May need to cutoff excess citation lines. Send anyway? ")
(error "Forgot to cutoff excess citation")))))))
(add-hook 'notmuch-mua-send-hook #'yant/notmuch-mua-too-long-cite-reminder))Fix “Exceed max-specpdl-size”
(setq max-specpdl-size 5000)Prevent interactive use of notmuch
Part of eliminating bad habits as in Distraction-free browsing.
(use-package notmuch
:defer t
:config
(define-advice notmuch (:override () disable)
"Disable `notmuch' command."
(error "Do something better!")))Avoid replying to “no-reply” when replying to all
(setq message-dont-reply-to-names `("noreply"
,user-mail-address))
(use-package notmuch
:defer t
:config
(defun yant/notmuch-honor-dont-reply-to-names ()
"Maybe remove To: header components according to `message-dont-reply-to-names'.
This should be called as a hook ran inside `message-header-setup-hook'."
(save-excursion
(when (and (eq major-mode 'notmuch-message-mode)
(message-fetch-field "To"))
(when-let ((new-headers (message-get-reply-headers t nil '("to" "cc"))))
(message-replace-header "To" (alist-get 'To new-headers))
(message-replace-header "Cc" (alist-get 'Cc new-headers))
(message-sort-headers)))))
(add-hook 'message-setup-hook #'yant/notmuch-honor-dont-reply-to-names))Highlight interesting text in emails
Semantic scholar and Google scholar alerts
(use-package notmuch
:config
(defun yant/notmuch-show-fontify-semanticscholar-email ()
"Fontify text part of semantic scholar New Citations email."
(when (and (eq major-mode 'notmuch-show-mode)
(string-match-p (regexp-quote "Semantic Scholar <do-not-reply@semanticscholar.org>") (notmuch-show-get-from)))
(save-excursion
(goto-char (point-min))
(when (search-forward "[ text/plain ]" nil t)
(while (search-forward "Learn more here:" nil t)
(save-excursion
(beginning-of-line -1)
(re-search-backward "^$")
(beginning-of-line 2)
(let ((beg (point)))
(re-search-forward "^$")
(let ((inhibit-read-only t))
(with-silent-modifications
(add-face-text-property beg (line-end-position -1)
'(face (:weight bold :underline t :background "Gainsboro"))))))))))))
(defun yant/notmuch-show-fontify-keywords ()
"Fontify interesting keywords according to `yant/elfeed-title-transforms'."
(when (and (eq major-mode 'notmuch-show-mode)
(string-match-p (regexp-opt '("Semantic Scholar <do-not-reply@semanticscholar.org>"
"Google Scholar Alerts <scholaralerts-noreply@google.com>"
"ScienceDirect Message Center <sciencedirect@notification.elsevier.com>"))
(notmuch-show-get-from)))
(let ((inhibit-read-only t))
(save-excursion
(cl-loop for (re repl display)
in yant/elfeed-title-transforms
do
(message-goto-body)
(while (re-search-forward re nil t)
(replace-match repl)
(when display
(with-silent-modifications
(apply #'put-text-property
(match-beginning 0)
(match-end 0)
display)))))))))
(add-hook! 'notmuch-show-hook #'yant/notmuch-show-fontify-semanticscholar-email)
(add-hook! 'notmuch-show-hook #'yant/notmuch-show-fontify-keywords))Mail host address
Not sure why I need to set it, but I don’t like “i-did-not-set–mail-host-address–so-tickle-me” inserted in my emails.(setq mail-host-address "localhost")Automatically translate non-English and non-Russian/Ukrainian titles.
Make it asyncEND[2021-07-26 Mon] Merge this with Custom title formatting
I read some articles in Chinese even though I do not really know how to read. Automatic translation is a bless. However, the available translation (in WeChat) do not offer translating article headlines in the new article list - I have to open every individual article and translate the whole thing one by one. It is time-consuming, especially since most of the articles are not really interesting. It would be sufficient to quickly look through the title to recognise that. So, I need some way to quickly get a translated list of recent article titles from WeChat (or any other source).
The best way for quick scanning across recent article titles is RSS. I use Elfeed to get updates on pretty much anything. Some websites provide native RSS. Some websites don’t, but I can still use RSSHub to convert the updates into RSS feed anyway. It provides a unified interface to keep track of all kinds of news.
However, Elfeed does not have the translation feature, so I am going to implement ad-hoc translation utilising translate-shell and langdetect.
from langdetect import detect
import sys
text=' '.join(sys.argv[1:])
print(detect(text))The elfeed formatting function implementing translation is actually merged together with Custom title formatting.
(when init-flag
;; (use-package guess-language
;; :straight t
;; :custom
;; (guess-language-languages '(en ru))
;; :config
;; )
(defun yant/guess-language-string (string)
"Guess language in the specified STRING."
(unless (executable-find "detect-language") (user-error "Command detect-language is not in PATH"))
(let (result)
(setq result
(s-trim-right
(shell-command-to-string (s-concat "detect-language \"" string "\""))))
(if (string-match-p "Traceback" result)
(error "Failed to run detect-language script: %S" result)
result)))
(use-package memoize
:straight t
:custom
(memoize-default-timeout nil)
:config
(defun yant/translate-string (string)
"Automatically translate STRING using trans shell command."
(unless (executable-find "trans") (user-error "Command trans is not in PATH"))
(s-trim (shell-command-to-string (format "trans -no-warn -b \"%s\"" string))))
(memoize #'yant/translate-string)
(memoize #'yant/guess-language-string)))ERC
(use-package erc
:requires erc-hl-nicks
:init
(use-package erc-hl-nicks
:straight t
:defer t)
:custom
(erc-default-server "irc.libera.chat")
(erc-nick "yantar92")
(erc-prompt-for-nickserv-password nil)
(erc-interpret-mirc-color t)
(erc-rename-buffers t)
(erc-lurker-hide-list '("JOIN" "PART" "QUIT"))
(erc-track-exclude-types '("JOIN" "NICK" "QUIT" "MODE"))
(erc-track-enable-keybindings nil)
(erc-fill-column 100)
(erc-fill-function #'erc-fill-static)
(erc-fill-static-center 20)
(erc-autojoin-channels-alist '(("irc.libera.chat" "#org-mode" "#systemcrafters")))
(erc-modules '( autoaway autojoin button completion fill
irccontrols keep-place list match menu
move-to-prompt netsplit networks noncommands
readonly ring stamp track smiley spelling hl-nicks))
:config
(use-package meta-functions
:config
(meta-defun meta-new-line :mode erc-mode (erc-send-current-line))))Typing speed
speed-type
[[id:Github-hagleitn-hagleitn-speed-type-48c][hagleitn [Github] hagleitn/speed-type: Practice touch/speed typing in emacs]]
(use-package speed-type
:if init-flag
:straight t)Org mode
This config is inspired by Bernt Hansen’s config.Describe the workflowEND(use-package org
:if (or init-flag org-export-flag org-tangle-flag)
:defer t)Workflow
Project management
I need to deal with many projects running at the same time in my work. Hence, I need some good structure for all these projects to keep track of deadlines, have all the notes to be able to recall what is going on in the project after some time.The projects are care most about are my research projects at work. And I treat most of my life projects pretty much like research projects (because when you have a hummer, everything around start looking like nails all of a sudden).
Research projects generally contain several typical components:
- Papers related to the project topic that I need to read (this tends to grow quite a lot at times)
- Actions I need to perform to understand the research question
- Ideas, which are not immediately useful, but might become handy as the project progresses
- Reporting/paperwork related to project
Tags
General org mode tags
(setq org-tag-alist (quote (("COMMON" . ?c)
("PhD" . ?p)
("INBOX" . ?i)
("TRACK" . ?t)
("BOOKMARK" . ?b)
("ORG" . ?o)
("NOEXPORT" . ?n)
("NODEADLINE" . ?d)
("SKIP" . ?s)
("NOARCHIVE" . ?a)
("ARCHIVEALL" . ?A)
("NOCLOCK" . ?k)
("ignore" . ?g)
("REFILE" . ?r)
("AREA" . ?E)
("FLAGGED" . ?F)
("@home" . ?h)
("@work" . ?w))))
(setq org-tags-exclude-from-inheritance '("ATTACH" "NOCLOCK"
"REFILE" "AREA"
"FLAGGED"
"project" "goal"))COMMON- General task
PhD- Related to work/PhD
INBOX- Need to be processed (for new captured tasks)
TRACK- The link from this task/item should be monitored for changes in the internet
BOOKMARK- Contains a link
ORG- if the task is not finished - include the org file linked during agenda creation if todo keyword is
NEXT.The purpose of this tag is reduce the file size: I had a large database of books, which I’ve read/will read. The file with all the authors included was more than2Mb, which took forever to open and, more importantly, made my agenda view build/update time few minutes. So, I created separate project for different authors and kept the links to that projects withORGtag assigned, so that I can add the author book list to file/agenda view if the project isNEXT.
- State “TODO” from “NEXT” [2018-09-20 Thu 22:32]
modification-hooks, insert-in-front-hooks, insert-behind-hooksEND
NOEXPORT- Do not export an item
NODEADLINE- Do not show these tasks in “All other tasks” part of my GTD self-check agenda view
SKIP- Some projects/sub-projects contains tasks, which can be done independently to each other. I want to see these tasks in “All other tasks” part of my GTD self-check agenda view even if the projects they belong to have
NEXTtasks. NOARCHIVE- Do not archive a task. This in not inherited.
ARCHIVE- Prevent task from unfolding (e.g. task contains bulky data, I do not want to see)
ARCHIVEALL- Do not archive individual tasks in the subtree. Only do it all together.
NOCLOCK- prevent entry from being clocked in automatically (after child task clock out Clocking & logging). This is not inherited.
DEFAULT- Do not list the task in GTD agenda
- NOFOLLOW
- Do not add link to this task capture
- REFILE
- can be refile target even if it is not project/sub-project
NOREFILE- cannot be refile target
TICKLER- The items refiled here will have their todo state changed to
TICKLER. AREA- Some projects are not “real” projects, but rather areas of interest. The difference with normal projects is that areas are not expected to be ever finished. Thus, it has little point to keep them in weekly review together with projects. However, they can be stuck, as any other project.
Tags for everything
try to implement multiple files/buffers in the same buffer via text properties like modification hooks |- (Special Properties - GNU Emacs Lisp Reference Manual)
modified bmay be useful |- (multifiles.el/multifiles.el at master · magnars/multifiles.el)fun create-orTasks
The task is any item with todo keyword and no subtask.(use-package org-ql
:defer t
:config
(org-ql-defpred-alias task ()
"Match a task without child subtasks."
(and (or (todo) (done))
(not (project)))))
(defun bh/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 (format "^%s" (org-get-limited-outline-regexp)) subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task (not has-subtask)))))- keywords for not done tasks:
TODO,NEXT,DOING,REVIEW,SOMEDAY,WAITING,HOLD,CANCELLED,DONE,FAILED,MERGED,TICKLER
(setq org-todo-keywords
(quote ((sequence "TODO(t)" "NEXT(n)" "DOING(o)" "REVIEW(e)" "|" "DONE(d!)" "FAILED(f@/!)" "MERGED(m!)" )
(sequence "SOMEDAY(s)" "WAITING(w@/!)" "HOLD(h@/!)" "TICKLER(l)" "|" "FROZEN(z@/!)" "CANCELLED(c@)" ))))
;; set the tags assigned to specific keywords. Not nesessary, but used by a lot of code for filtering later - hence why not
(setq org-todo-state-tags-triggers
(quote (("CANCELLED" ("SOMEDAY") ("CANCELLED" . t))
("WAITING" ("SOMEDAY") ("CANCELLED") ("WAITING" . t))
("HOLD" ("SOMEDAY") ("CANCELLED") ("WAITING") ("HOLD" . t))
("SOMEDAY" ("CANCELLED") ("WAITING") ("HOLD") ("SOMEDAY" . t))
(done ("SOMEDAY") ("WAITING") ("HOLD"))
("TODO" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("NEXT" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("TICKLER" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("REVIEW" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("DOING" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("DONE" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD"))
("FAILED" ("SOMEDAY") ("WAITING") ("CANCELLED") ("HOLD")))
))- TODO(t)
- task which needs to be reviewed and marked with one of the following keywords. TODO tasks are generally tasks I may consider doing, but do not know any details about what they are and how to proceed with doing them.
- NEXT(n)
- Task which needs to be done next
- DOING(o)
- A task I am working on, but do not expect to finish quickly (e.g. reading book). Marking this task
DOING =-> =DOING, reschedules it to tomorrow. Marking a task DOING if it had other keyword and not scheduled, schedules it for today and asks for effort estimate.
(defun org-trigger-doing (arg)
"Restore DOING keyword after DOING->DONE or DOING->DOING change and handle setting DOING.
^DOING->DOING: If the task does not have effort estimate, set it.
^DOING->DOING: If the task is unscheduled, schedule it today.
DOING->DOING: If the task is unscheduled or has no repeater, schedule it for tomorrow.
DOING->DOING: If the task has a repeater, re-schedule it accordingly
DOING->DONE/REVIEW: Cancel repeater and mark the task DONE."
(when (and (eq (plist-get arg :type) 'todo-state-change)
(not (string= (plist-get arg :from) "DOING"))
(string= (plist-get arg :to) "DOING"))
(unless (org-with-point-at (plist-get arg :position) (org-element-property :scheduled (org-element-at-point)))
(org-schedule nil "."))
(unless (org-with-point-at (plist-get arg :position) (org-element-property :EFFORT (org-element-at-point)))
(org-set-effort)))
(when (and (eq (plist-get arg :type) 'todo-state-change)
(string= (plist-get arg :from) "DOING")
(or (string= (plist-get arg :to) "DOING")
(member (plist-get arg :to) org-done-keywords)))
(let* ((pos (plist-get arg :position))
(schedule-info (org-with-point-at pos (org-element-property :scheduled (org-element-at-point)))))
(when schedule-info
(let ((repeater (or (org-with-point-at pos (org-get-repeat))
"+1d")))
(if (member (plist-get arg :to) org-done-keywords)
(org-schedule nil ".+0d") ;; revert the default re-schedule triggered by DONE
(org-set-property "SHOWFROMDATE"
(ts-format "%Y-%m-%d"
(ts-parse-org
(org-read-date nil nil (s-replace "." "" repeater)))))) ;; do not reschedule (I am still working on the task), but show later
(when (member (plist-get arg :to) org-done-keywords)
(if (y-or-n-p (format "Trying to mark DOING task as %s. Proceed? " (plist-get arg :to)))
(org-with-point-at pos
(org-cancel-repeater)
(org-todo (plist-get arg :to)))
(org-todo "DOING")))))
(when (and (marker-buffer org-clock-marker)
(marker-position org-clock-marker)
(equal (marker-position pos)
(org-with-point-at org-clock-marker (org-back-to-heading 't))))
(org-clock-out)))))
(add-hook 'org-trigger-hook #'org-trigger-doing)
- REVIEW(e)
- A task is basically done, but should be reviewed (i.e. consider putting to knowledge base). Unschedule the task when set.
- WAITING(w)
- I am waiting for someone/something which does not depend on me to start the task (should add comment about reason). The command triggers unscheduling the task and clocking out.
(defun org-trigger-waiting (arg)
"Handle setting WAITING todo keyword.
Unschedule when WAITING is set."
(when (and (eq (plist-get arg :type) 'todo-state-change)
(not (string= (plist-get arg :from) "WAITING"))
(string= (plist-get arg :to) "WAITING"))
(let ((pos (plist-get arg :position)))
(when (and (marker-buffer org-clock-marker)
(marker-position org-clock-marker)
(equal (marker-position pos)
(org-with-point-at org-clock-marker (org-back-to-heading 't))))
(org-clock-out))
(let (found)
(while (and (org-up-heading-safe)
(or (string= "NEXT" (org-get-todo-state))
(not (org-get-todo-state)))
(not found))
(save-restriction
(org-narrow-to-subtree)
(if (save-excursion
(beginning-of-line 2)
(re-search-forward "^\\*+ \\(TODO\\|NEXT\\)" nil t))
(setq found t)
(when (org-get-todo-state)
(org-todo "WAITING")))))))))
(add-hook 'org-trigger-hook #'org-trigger-waiting)- HOLD(h)
- I am not going to do this task for now because of lack of time/low priority. The command triggers unscheduling the task.
- FROZEN(z)
- I should have been done, but it haven’t and not because of me. It might be in the future, but unlikely.
- TICKLER(l)
- This task should appear in agenda from time to time, so that I do not forget about it. When the task state is changed TICKLER->TICKLER, it is rescheduled using spaced repetition method.
(use-package org-drill
:after org
:straight t
:config
(defun yant/org-smart-reschedule (quality)
"Interactively call `org-drill-smart-reschedule'."
(interactive "nIdea: (1) what is it? (2) need to check closely (3) real use soon (4) check when free (5) maybe: ")
(let ((next-days (org-drill-hypothetical-next-review-date quality)))
(if (= next-days 0) (setq next-days 1))
(if (and (< quality 4) (> next-days 40)) (setq next-days 40)) ;; Hard limit on postponing.
(if (and (= quality 4) (> next-days 90)) (setq next-days 90))
(org-drill-smart-reschedule quality next-days)))
(defun org-trigger-tickler (arg)
"Restore TICKLER keyword after TICKLER->DONE or TICKLER->TICKLER change and handle setting TICKLER.
^TICKLER->TICKLER: If the task is unscheduled, schedule it today.
TICKLER->TICKLER: Reschedule the task using `org-drill-smart-reschedule'.
TICKLER->DONE/REVIEW: Mark the task DONE."
(require 'org-learn)
(when (and (eq (plist-get arg :type) 'todo-state-change)
(not (string= (plist-get arg :from) "TICKLER"))
(string= (plist-get arg :to) "TICKLER"))
(unless (org-with-point-at (plist-get arg :position) (org-element-property :scheduled (org-element-at-point)))
(org-schedule nil ".")))
(when (and (eq (plist-get arg :type) 'todo-state-change)
(string= (plist-get arg :from) "TICKLER")
(or (string= (plist-get arg :to) "TICKLER")
(member (plist-get arg :to) org-done-keywords)))
(let* ((pos (plist-get arg :position))
(schedule-info (org-with-point-at pos (org-element-property :scheduled (org-element-at-point)))))
(unless schedule-info (org-schedule nil "."))
(if (member (plist-get arg :to) org-done-keywords)
(unless (y-or-n-p (format "Trying to mark TICKLER task as %s. Proceed? " (plist-get arg :to)))
(org-todo "TICKLER"))
(call-interactively #'yant/org-smart-reschedule)
(add-transient-hook! 'post-command-hook
(let ((marker (org-with-point-at-org-buffer (org-back-to-heading t) (point-marker)))
(ts (org-with-point-at-org-buffer (org-entry-get (point) "SCHEDULED"))))
(dolist (agenda-buffer (mapcar #'get-buffer
(seq-filter (apply-partially #'s-contains-p "*Org Agenda")
(mapcar #'buffer-name (buffer-list)))))
(when (buffer-live-p agenda-buffer)
(with-current-buffer agenda-buffer
(save-excursion
(goto-char (point-min))
(while (< (point) (point-max))
(when (equal marker (org-get-at-bol 'org-hd-marker))
(org-agenda-show-new-time (org-get-at-bol 'org-marker) ts " S"))
(beginning-of-line 2))))))))))))
(add-hook 'org-trigger-hook #'org-trigger-tickler))- SOMEDAY(s)
- This task appears to be interesting and worth doing but does not have to be done at all. The command triggers unscheduling the task if it is scheduled and clocking out.
(defun yant/unschedule-maybe ()
"Unschedule task when it keyword is changed to SOMEDAY."
(let ((mystate (or (and (fboundp 'org-state)
state)
(nth 2 (org-heading-components)))))
(when (member mystate (list "SOMEDAY" "HOLD" "WAITING" "REVIEW"))
(org-schedule '(4)))))
(add-hook 'org-after-todo-state-change-hook 'yant/unschedule-maybe 'append)
(defun org-trigger-someday (arg)
"Handle setting SOMEDAY todo keyword.
Unschedule when SOMEDAY is set."
(when (and (eq (plist-get arg :type) 'todo-state-change)
(not (string= (plist-get arg :from) "SOMEDAY"))
(string= (plist-get arg :to) "SOMEDAY"))
(let ((pos (plist-get arg :position)))
(when (and (marker-buffer org-clock-marker)
(marker-position org-clock-marker)
(equal (marker-position pos)
(org-with-point-at org-clock-marker (org-back-to-heading 't))))
(org-clock-out)))))
(add-hook 'org-trigger-hook #'org-trigger-someday)- CANCELLED(c)
- I will not do this task because of what is in the comment
- DONE(d)
- self-explanatory
- FAILED(f)
- there is some outcome and can mark done, but the outcome is not positive, though can get some conclusions out of it
- MERGED(m)
- become a part of other task. The link to the task is added to
MERGED-WITHproperty. The motivation of adding this state is that I sometimes create a duplicate task, find out that it is duplicate, and confused which state to set. It is just faster to setMERGEDwithout deciding if it isCANCELLED(which is not really) orDONE(which is also not).
(defun org-trigger-merged (arg)
"Prompt and insert a link to related task when changing to MERGED state."
(when (and (eq (plist-get arg :type) 'todo-state-change)
(string= (plist-get arg :to) "MERGED")
(not (string= (plist-get arg :from) (plist-get arg :to))))
(let* ((pos (plist-get arg :position)))
(org-with-point-at pos
(org-set-property "MERGED-WITH" "undefined")
(when (re-search-forward (org-re-property "MERGED-WITH") nil 'noerror)
(replace-match "" nil nil nil 3)
(funcall-interactively #'org-insert-link))))))
(add-hook 'org-trigger-hook #'org-trigger-merged)In some cases, I do not want to have logging on CANCELLED/FAILED/HOLD/WAITING.
For example, a task to listen music with outcome of FAILED mostly have the same meaning - I do not like the music.
Writing the note is useless in such a case.
So, I define :LOGGING: property in some subtrees to avoid logging.
Inline tasks
I use inline tasks to add temporary todo state (instead of notes). It should be removed once done and placed into notes when archiving.Implement this on inline task doneEND(use-package org
:defer t
:config
(use-package org-inlinetask
:demand t
:config
(setq org-inlinetask-default-state "TODO")
(setq org-inlinetask-min-level 18)))It seems that inline tasks interferes with org-outline-regexp.
Fix it:
(defun org-outline-regexp-no-inline ()
"Return string matching an non-inline task heading.
The maximum number of levels is controlled by `org-inlinetask-min-level'."
(let* ((org-inlinetask-min-level (- org-inlinetask-min-level 1))
(nstars (if org-odd-levels-only
(1- (* org-inlinetask-min-level 2))
org-inlinetask-min-level)))
(format "^\\(\\*\\{1,%d\\}\\)[ \t]+" nstars)))
;; (define-advice org-back-to-heading (:around (oldfun &optional args) skip-inlinetasks)
;; "Ignore preceding inline tasks when calling outline-back-to-heading."
;; (if (org-inlinetask-in-task-p)
;; (funcall oldfun args) ;; inside inlinetask - just go to heading
;; (let ((outline-regexp (org-outline-regexp-no-inline)))
;; (funcall oldfun args))))
;; (advice-remove 'org-back-to-heading #'org-back-to-heading@skip-inlinetasks)By default, org-mode does not allow storing links to inline headings. It is really strange. I force org-mode to store link to inline headings by adding inline heading store link function.
report to org-modeEND(defun org-inlinetask-store-link (oldfun &rest args)
"Store link to inlinetask at point."
(if (and (derived-mode-p 'org-mode)
(org-inlinetask-in-task-p))
(let ((org-inlinetask-min-level (1+ org-inlinetask-max-level)))
(apply oldfun args))
(apply oldfun args)))
(advice-add 'org-store-link :around #'org-inlinetask-store-link)Task dependencies
- State “TODO” from [2018-03-12 Mon 17:59]
TRIGGER and BLOCKER (see Properties for details)
(use-package org-edna
:straight t
:after org
:diminish org-edna-mode
:config
(org-edna-mode))This can be useful, for example, when watching a series.
I may add multiple TODOs for different series, but it usually make sense to watch them in sequence.
I can do it using org-edna
(use-package org-edna
:after org
:bind (:map org-mode-map
("C-c C-x M-p" . yant/org-set-preceding-task))
:config
(defun yant/org-set-preceding-task ()
"Make task at point follow other task.
The current task will be marked WAITING and cannot be marked DONE
until the other task is completed.
Its :SUMMARY: property will contain the information about the blocker
Completing the other task will automatically set the current task to
NEXT and schedule it the same day."
(interactive)
(let ((uuid (org-id-prompt-id))
(cur-uuid (org-id-get-create)))
(unless uuid (user-error "Did not get a uuid"))
(org-todo "WAITING")
(org-set-property "BLOCKER" (format "ids(\"%s\")" uuid))
(org-set-property "SUMMARY" (format "Blocked by %s" (org-with-point-at (org-id-find uuid 'marker) (org-get-heading t t t t))))
(org-with-point-at (org-id-find uuid 'marker)
(let ((old (org-entry-get (point) "TRIGGER")))
(unless old (setq old ""))
(org-set-property "TRIGGER" (format "%s ids(\"%s\") todo!(NEXT) scheduled!(\".\") delete-property!(\"SUMMARY\")" old cur-uuid)))))))Also, the projects require all the children to be done by default.
(setq org-enforce-todo-dependencies t)In addition, I force all the check-boxes to be checked before a task can be marked done. Otherwise, there is not much point in check-boxes for me.
(use-package org
:defer t
:custom
(org-enforce-todo-checkbox-dependencies t))Repeating tasks
By default, tasks with repeated are changed to “TODO” state. I prefer “NEXT”.
(use-package org
:if init-flag
:defer t
:custom (org-todo-repeat-to-state "NEXT"))Habits
Habits are regular tasks which are treated specially in agenda to show if I missed it.
(use-package org-habit
:after org
:config
(setq org-habit-graph-column 120))Any tasks can be made a habit by adding an appropriate properties. I have two ways to do it:
- through capture
- calling a custom function
(defun yant/org-task-convert-to-habit ()
"Make task at point a habit."
(interactive)
(org-with-wide-buffer
(unless (org-entry-is-todo-p)
(when (y-or-n-p (format "Current entry is not a task ("%s").\nChange todo state?" (org-get-heading 'no-tags)))
(funcall-interactively #'org-todo)))
(cl-mapc #'org-set-property
'("STYLE" "REPEAT_TO_STATE" "LOGGING" "ARCHIVE")
'("habit" "NEXT" "DONE(!)" "%S_archive_%y.org::* Habits"))
(message "Task is not habit.")))
(bind-key "C-c C-x h" #'yant/org-task-convert-to-habit org-mode-map)Allow checklists to be reset in recurring tasks when :RESET_CHECK_BOXES: is t
(use-package org-checklist
:after org
:config
(add-to-list 'org-default-properties "RESET_CHECK_BOXES"))Do not show consistency graph in agenda
(define-advice org-habit-insert-consistency-graphs (:override () disable) #'ignore)Projects
The project is an item with todo keyword and subtask.
(use-package org-ql
:defer t
:config
(org-ql-defpred-alias project ()
"Match a project - task with a todo subtask or :project: tag."
(or (tags-local "project")
(and
(todo)
(not (goal))
(descendants (and
(or (todo) (done))
(not (org-inlinetask-at-task-p))
;; TODO: report bug
;; (level "<" ,org-inlinetask-min-level)
))))))
(defun bh/is-project-p ()
"Any task with a todo keyword subtask or :project: tag."
(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)))
(when is-a-task
(if (member "project" (org-get-tags-at (point) 'local))
t
(save-excursion
(forward-line 1)
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (and (not (org-inlinetask-at-task-p))
(member (org-get-todo-state) org-todo-keywords-1))
(setq has-subtask t))))
has-subtask)))))This approach is useful in the case if I place some todo under the wrong item during refiling. It will appear in the project list in such a case. Project cannot be DONE if any of subtasks is TODO, NEXT, WAITING or HOLD (see Task inheritance)
Top level project
The project without parent projects.(defun bh/find-project-task ()
"Move point to the parent (project) task if any."
(save-restriction
(widen)
(let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
(while (org-up-heading-safe)
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq parent-task (point))))
(goto-char parent-task)
parent-task)))
(use-package org-ql
:defer t
:config
(org-ql-defpred-alias subtask ()
"A subtask of a project."
(and (or (todo) (done))
(ancestors (project)))))
(defun bh/is-project-subtree-p ()
"Any task with a todo keyword that is in a project subtree.
Callers of this function already widen the buffer view."
(let ((task (save-excursion (org-back-to-heading 'invisible-ok)
(point))))
(save-excursion
(bh/find-project-task)
(if (equal (point) task)
nil
t))))Sub-project
The project with parent projects.(use-package org-ql
:defer t
:config
(org-ql-defpred-alias subproject ()
"Match a subproject."
(and (project)
(not (tags-local "project"))
(ancestors (project)))))
(defun bh/is-subproject-p ()
"Any task which is a subtask of another project"
(let ((is-subproject)
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
(save-excursion
(while (and (not is-subproject) (org-up-heading-safe))
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq is-subproject t))))
(and is-a-task is-subproject)))
- if any task below is
NEXTand the project isWAITINGthen need to change toNEXT(it means that we need to do some task from this sub-project next)(defun yant/mark-todo-parent-tasks-next () "Visit each parent task and change WAITING states to NEXT." (let ((mystate (or (and (fboundp 'org-state) state) (nth 2 (org-heading-components))))) (when (member mystate (list "NEXT")) (save-excursion (while (org-up-heading-safe) (when (member (nth 2 (org-heading-components)) org-todo-keywords-1) (when (member (org-get-todo-state) '("WAITING")) (org-todo "NEXT")))))) (when (member mystate (list "TODO")) (save-excursion (while (org-up-heading-safe) (when (member (nth 2 (org-heading-components)) (list "DONE")) (org-todo "TODO"))))))) (add-hook 'org-after-todo-state-change-hook 'yant/mark-todo-parent-tasks-next 'append) (add-hook 'org-after-refile-insert-hook #'yant/mark-todo-parent-tasks-next)
Tracked projects (listed in GTD project list)
The above definition of a project creates really many small projects and sub-projects. Eventually, the number becomes so high that it is nearly impossible to review them regularly (as recommended by GTD [[id:1f151305-2d61-42b9-9438-503c9b538352][Allen [2015] Getting things done]]). However, some particularly complex (or large) projects do need to be tracked manually to keep the number of daily tasks sane. These projects are marked with :project: tag and listed in weekly review.
Sometimes, I can even mark sub-projects with this tag if the sub-projects are important enough to review the progress regularly.
Journal
- State “NEXT” from [2018-10-23 Tue 18:50]
Sometimes, I do some trial tasks for my projects or just try random things with programming. These things are unlikely to go into my actual notes or projects files. Not always though. It is always frustrating when I remember trying something and want to move it to actual notes of project file, but lose what I did.
Journal seems to be a good solution for it. I can dump all kind of staff there instead of having it spread over the bash history or just lost. I can write notes, run shell commands, calculations, etc without loosing what I have done. I may not even need to run terminal in such a case!
I have tried org-journal, but it does not really work for me because it creates too many files. A simple date-tree capture works just fine.
(use-package org-capture
:if init-flag
:after org
:requires org
:config
(defvar yant/org-journal-file "~/Org/Journal.org"
"Filename of the journal file")
(use-package doct
:defer t
:config
(asoc-put! org-capture-templates
"j"
(cdar (doct '("Journal entry"
:keys "j"
:type entry
:file yant/org-journal-file
:datetree t
:clock-in t
:clock-resume t
:jump-to-captured t
:template
("* %?"
":PROPERTIES:"
"CREATED: %U"
":END:\n"))))
'replace)))Files
- TODO.org
- store new entries, general home and work entries, want todo some time entries
(when init-flag (defun gtd-open () (interactive) (find-file "~/Org/TODO.org")))
- notes.org
- all kind of generally useful information
(when init-flag (defun notes-open () (interactive) (find-file "~/Org/notes.org")))
- articles.org
- notes on research articles
- rss.org
- rss entries for Elfeed
- contacts.org
- my contacts via
org-contacts - *.org
- project specific entries
- all of it is in
agenda_files - we can add new org files and remove existing
(when init-flag
(defun add-buffer-to-agenda-files (buffer)
(let ((file_name (buffer-file-name buffer)))
(with-temp-file "~/Org/agenda_files"
(interactive)
(insert-file-contents "~/Org/agenda_files")
(beginning-of-buffer)
(let ((pos (search-forward file_name nil 't)))
(when (not pos)
(end-of-buffer)
(newline)
(insert file_name)
(message "%S is added to agenda_files" file_name)
)
(when pos
(message "%S is already in agenda_files" file_name))
)
)
)
)
(defun add-current-buffer-to-agenda-files ()
(interactive)
(add-buffer-to-agenda-files (current-buffer))
)
(defun remove-buffer-from-agenda-files (buffer)
(let ((file_name (buffer-file-name buffer)))
(with-temp-file "~/Org/agenda_files"
(interactive)
(insert-file-contents "~/Org/agenda_files")
(beginning-of-buffer)
(let ((pos (search-forward file_name nil 't)))
(when (not pos)
(message "%S is not in agenda_files" file_name))
(when pos
(beginning-of-buffer)
(delete-matching-lines file_name)
(message "%S is deleted from agenda_files" file_name)
)
)
)
)
)
(defun remove-current-buffer-from-agenda-files ()
(interactive)
(remove-buffer-from-agenda-files (current-buffer))
))Links
Link description function
- State “WAITING” from “HOLD” [2020-09-24 Thu 21:55]
- State “HOLD” from “SOMEDAY” [2020-09-24 Thu 21:55]
Get reply to my patch
- State “NEXT” from “TODO” [2019-05-07 Tue 10:34]
(defun yant/org-make-link-description-function (link desk)
"Return description of the link LINK according to :desk link property.
Return DESK if :desk is not set."
(let ((fun (org-link-get-parameter (car (split-string link ":")) :desk)))
(if (functionp fun)
(funcall fun link desk)
desk)))
(setq org-link-make-description-function #'yant/org-make-link-description-function)External
External apps
Adjust some of the external application programs(setq org-file-apps '((directory . emacs)
("\\.bib\\'" . emacs)
("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
("\\.pdf\\'" . emacs)
("\\.mp4\\'" . "mpv %s")
("\\.tiff?\\'" . "feh-open %s")
("\\.png?\\'" . "feh-open %s")))Pdf-view links
Store links to pages in pdf
(use-package org-pdftools
:straight t
:after (org pdf-tools)
:config
(org-pdftools-setup-link))
(add-to-list 'org-file-apps '("\\.pdf\\'" . (lambda (file link) (org-pdfview-open link))))
(setq org-file-apps (delete '("\\.pdf\\'" . (lambda (file link) (org-pdfview-open link))) org-file-apps ))Inkscape (svg) links
Open and preview inkscape svg files. Copy paste from https://github.com/jkitchin/scimax/blob/master/scimax-inkscape.el(use-package scimax-inkscape
:straight (scimax-inkscape :host github :files ("scimax-inkscape.el") :repo "jkitchin/scimax"))Links to attached files
- State “DONE” from “TODO” [2019-04-24 Wed 17:15]
- State “TODO” from [2018-07-23 Mon 15:33]
- State “TODO” from [2018-07-10 Tue 22:49]
- State “TODO” from [2018-07-09 Mon 21:47]
I have symlinks to the attached files stored in the directory tree mimicking org file structure (see Store files in folder structure, following my org tree structure)
However, they can be moved upon refiling.
Hence, it is better to avoid file links to the attached files.
Therefore, I define a new link type to the attached files of the current entry.
Note that if helm-find-files is used in emacs, it is possible to C-c C-f while selecting an image link - it will show the preview of images in separate buffer (idea from reddit).
org-attach-dir-symlink. slowing down flycheck too muchEND
(defmacro org-with-point-at-org-buffer (&rest body)
"If in agenda, put the point into the corresponding org buffer."
`(cond ((eq major-mode 'org-agenda-mode)
(when-let ((marker (org-get-at-bol 'org-hd-marker))
(agenda-buffer (current-buffer)))
(org-with-point-at marker
,@body)))
((eq major-mode 'org-mode)
(org-with-wide-buffer
,@body))
(t (display-warning :warning "Trying to call org function in non-org buffer."))))
(defmacro org-with-point-at-org-buffer-drop-excursion (&rest body)
"If in agenda, put the point into the corresponding org buffer.
Do not save excursion."
`(cond ((eq major-mode 'org-agenda-mode)
(when-let ((marker (org-get-at-bol 'org-hd-marker))
(agenda-buffer (current-buffer)))
(org-with-point-at-drop-excursion marker
,@body)))
((eq major-mode 'org-mode)
(org-with-wide-buffer-drop-excursion
,@body))
(t (display-warning :warning "Trying to call org function in non-org buffer."))))
(defmacro org-with-point-at-drop-excursion (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY.
Do not save excursion."
(declare (debug (form body)) (indent 1))
(org-with-gensyms (mpom)
`(let ((,mpom ,pom))
(when (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
(org-with-wide-buffer-drop-excursion
(goto-char (or ,mpom (point)))
,@body))))
(defmacro org-with-wide-buffer-drop-excursion (&rest body)
"Execute body while temporarily widening the buffer.
Do not save excursion."
(declare (debug (body)))
`(save-restriction
(widen)
,@body))
(setq org-link-file-path-type 'relative)
(defun yant/process-att-abbrev (arg)
"Return `org-attach-dir' for the current entry."
(s-concat (f-slash
;; (org-attach-dir-symlink 'CREATE)
(let ((org-attach-dir-suppress-extra-checks t)) (org-attach-dir))
)
arg))
(add-to-list 'org-link-abbrev-alist (cons "att" "attachment"))
;; (defun org-att-link-complete (&optional arg)
;; "Completion function for att: link."
;; (let* ((ref-dir (org-attach-dir 'CREATE))
;; (filelink (let ((default-directory (f-slash ref-dir)))
;; (org-file-complete-link)))
;; (filepath (apply #'s-concat (cdr (s-split ":" filelink)))))
;; (format "att:%s" filepath)))
;; (org-link-set-parameters "att"
;; :complete #'org-att-link-complete)Just links to the current entry are not always sufficient. I sometimes want to link a file from another entry.
(defun yant/process-att-id-abbrev (arg)
"Return `org-attach-dir' for the entry in att-id: link type."
(require 'org-ql)
(let ((id (car (s-split ":" arg)))
(file (cadr (s-split ":" arg))))
(s-concat (f-slash (let* ((org-attach-dir-suppress-extra-checks t)
(pos (org-id-find id 'marker)))
(org-with-point-at pos
(org-attach-dir 'CREATE))))
file)))
;; Cache results
(memoize #'yant/process-att-id-abbrev)
(add-to-list 'org-link-abbrev-alist (cons "att-id" "file:%(yant/process-att-id-abbrev)"))
;; FIXME: file: links cannot have custom follow:
;; (defun org-att-id-follow (path &optional arg)
;; "Follow att-id: link"
;; (if arg
;; (let ((id (car (s-split ":" path))))
;; (org-link-open-from-string (concat "id:" id)))
;; (org-link-open-from-string (concat "file:" (yant/process-att-id-abbrev path)))))
(defun org-att-id-skip-function ()
"Test if an entry contains attachments. Move point to next candidate location."
(if (yant/org-task-has-attachments-p)
't
(and (search-forward org-attach-auto-tag nil 'noerror)
(beginning-of-line)
(backward-char))))
(defun org-att-id-prompt-id ()
"Prompt for the id during completion of att-id: link.
If there is an id: link in `org-store-link-plist' suggest that heading.
Show parent project as top (or second top) suggestion."
(let (parent-project
saved-id)
(when (eq major-mode 'org-mode)
(org-with-point-at (point)
(org-back-to-heading)
(while (and (not parent-project)
(org-up-heading-safe))
(when (and (bh/is-project-p)
(not (bh/is-subproject-p)))
(setq parent-project (list (s-join "/"
(mapcar (lambda (str) (replace-regexp-in-string "/" "\\\\/" str))
(append (list (f-filename (buffer-file-name (buffer-base-buffer))))
(org-get-outline-path 'with-self 'use-cache))))))))))
(when (string= "id" (plist-get org-store-link-plist :type))
(org-with-point-at (org-id-find (cadr (split-string (plist-get org-store-link-plist :link) ":")) 'marker)
(setq saved-id (list (s-join "/"
(mapcar (lambda (str) (replace-regexp-in-string "/" "\\\\/" str))
(append (list (f-filename (buffer-file-name (buffer-base-buffer))))
(org-get-outline-path 'with-self 'use-cache))))))))
(let ((org-refile-history (append saved-id parent-project))
(org-refile-cache nil)
(org-refile-target-verify-function #'org-att-id-skip-function))
(let ((prompt-ans (org-refile-get-location "Link to attachment from")))
(prog1
(org-id-get (seq-find #'markerp
prompt-ans)
'create))))))
(defun org-att-id-link-complete (&optional arg)
"Completion function for att-id: link."
(let* ((id (org-att-id-prompt-id))
(ref-dir (org-with-point-at (org-id-find id 'marker)
(org-attach-dir 'CREATE)))
(filelink (let ((default-directory (f-slash ref-dir)))
(org-file-complete-link)))
(filepath (apply #'s-concat (cdr (s-split ":" filelink)))))
(format "att-id:%s:%s" id filepath)))
(defun org-att-id-link-description (link desc)
"Return description of an att-id: link."
(if (not (seq-empty-p desc))
desc
(when-let ((id (nth 1 (s-split ":" link)))
(file (nth 2 (s-split ":" link))))
(org-with-point-at (org-id-find id 'marker)
(when-let ((heading (org-get-heading 'no-tags 'no-todo 'no-priority 'no-comment)))
(s-concat heading ":" file))))))
(defun org-att-id-store-link ()
"Store att-id: link."
(save-match-data
(when (and (memq major-mode '(dired-mode image-mode))
(string-match (regexp-quote (f-expand org-attach-id-dir))
(f-expand default-directory))
(string-match (s-concat (regexp-quote (f-expand org-attach-id-dir))
"\\([0-9a-z][0-9a-z]\\)/\\([0-9a-z-_]+\\)/\\(.+\\)$")
(pcase major-mode
('dired-mode (dired-get-filename))
('image-mode (buffer-file-name)))))
(let* ((filename (pcase major-mode
('dired-mode (dired-get-filename))
('image-mode (buffer-file-name))))
(id (concat (match-string 1 filename)
(match-string 2 filename)))
(link (match-string 3 filename)))
(org-link-store-props :type "att-id"
:link (concat "att-id:" id ":" link)
:description (org-att-id-link-description (concat "att-id:" id ":" link) ""))))))
(org-link-set-parameters "att-id"
:complete #'org-att-id-link-complete
:store #'org-att-id-store-link
:follow #'org-att-id-follow
:desk #'org-att-id-link-description)
Internal
Links by ID
(use-package org-id
:after org)
(setq org-id-method (quote uuidgen))
(setq org-id-link-to-org-use-id 't)id: link completion
(defvar org-id-history nil
"ID completion history for id: link type.")
(defun org-id-prompt-id ()
"Prompt for the id during completion of att-id: link."
;; (org-id-get-with-outline-path-completion '((org-agenda-files :maxlevel . 100)))
(require 'helm-org-ql)
(let ((helm-org-ql-actions '(("Get id" . (lambda (mk) (org-with-point-at mk (org-id-get-create)))))))
(helm-org-ql (org-agenda-files t) :name "Select heading")))
(defun org-id-link-complete (&optional arg)
"Completion function for id: link."
(let* ((id (org-id-prompt-id)))
(format "id:%s" id)))
(defun org-id-link-desk (link desk)
"Description function for id: link."
(or desk
(let ((id (cadr (split-string link ":"))))
(org-with-point-at (org-id-find id 'marker)
(org-get-heading 'stip 'all 'the 'extra)))))
(org-link-set-parameters "id"
:complete #'org-id-link-complete
:desk #'org-id-link-desk)Footnotes
- State “TODO” from [2018-10-23 Tue 21:45]
(setq org-footnote-section nil)Src block links
The links to run src blocks.
Useful if I want to run an src block when working on entry.
Having a link, which runs blocks, allows to simply C-c C-o on the heading to follow this link.
(defun org-link-babel-follow (name &optional return-info)
"Run src block NAME from babel:name link.
The NAME is parsed as in #+CALL: specification.
The src block should be in the same org file."
(let* ((call (with-temp-buffer
(interactive)
(org-mode)
(insert "#+CALL: " (format "%s" (org-link-unescape name)) "\n")
(beginning-of-buffer)
(org-element-babel-call-parser (point-max) (list (point-min)))
))
(info (org-babel-lob-get-info call)))
(if return-info
info
(cl-letf (((symbol-function 'org-babel-insert-result) (lambda (&rest _) nil)))
(org-babel-execute-src-block nil info)))))
(defun org-link-babel-complete ()
"Complete babel: link at point."
(let* ((name (completing-read "Source block name: " (org-babel-src-block-names)))
(block-info (org-link-babel-follow (format "%s()" name) 'return-info))
(block-lang (car block-info))
(block-default-params (nth 2 block-info))
(block-params (nth 2 (org-link-babel-follow (format "%s()" name) 'return-info))) ;; call again to make a new sequence
(lang-headers-var (intern (concat "org-babel-header-args:" block-lang)))
(lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t)))
(headers-w-values (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values lang-headers))
(headers (mapcar (apply-partially #'format ":%s") (mapcar #'symbol-name (mapcar #'car headers-w-values))))
params)
(while (not params)
(setq params (org-completing-read "Header Arg: " (cons (format "Default: %s" block-params) headers)))
(unless (string= params (format "Default: %s" block-params))
(let* ((args (cdr (assoc (intern (substring params 1)) headers-w-values)))
(args (if (listp args) args nil))
(arg (org-completing-read
(format "%s: " params)
(append (and args (mapcar #'symbol-name (apply #'append args)))
(list (alist-get (intern params) block-params))))))
(setf (alist-get (intern params) block-params) arg)
(setq params nil))))
(setq params (seq-difference block-params block-default-params))
(let ((var-params (alist-get :var params)))
(setq params (seq-difference params (list (cons :var (alist-get :var params)))))
(when params (setq params (s-join " " (mapcar (lambda (el) (format "%s %s" (car el) (cdr el))) params))))
(when var-params (setq var-params (format "%s" var-params)))
(format "babel:%s[%s](%s)" name (or params "") (or var-params "")))))
(org-link-set-parameters "babel"
:follow #'org-link-babel-follow
:complete #'org-link-babel-complete)Active links
I sometimes use elisp: links to execute a meaningful action required to start working on a task. For example, checking email require opening notmuch window (I prefer to not bind such action to a key in order to break destructing habit of checking email mindlessly).
Do not ask every time I try to evaluate elisp: links
(use-package org
:if init-flag
:defer t
:config
(setq org-link-elisp-confirm-function nil))Org-ref
- State “NEXT” from “TODO” [2018-10-10 Wed 11:43]
- State “TODO” from [2018-03-12 Mon 18:04]
(use-package org-ref
:if init-flag
:straight (org-ref :type git :host github :repo "jkitchin/org-ref" :local-repo "~/Git/org-ref"
:fork (:host github :repo "yantar92/org-ref"))
:after org
:init
(use-package bibtex-completion :demand t)
(use-package lv :straight t)
(setq org-ref-show-citation-on-enter nil) ;; this slows down org mode a lot otherwise
:config
(setq org-latex-prefer-user-labels t)
(setq org-ref-show-broken-links nil) ;; it makes typing very slow if 't
(use-package org-ref-pdf)
(use-package org-ref-url-utils)
(setq org-ref-bibliography-notes "~/Git/Books/articles/articles.org"
bibtex-completion-notes-path "~/Git/Books/articles/articles.org"
org-ref-default-bibliography '("~/Git/Books/References.bib")
org-ref-pdf-directory "~/Git/Books/articles/_symlinks/"
bibtex-completion-library-path org-ref-pdf-directory)
(setq reftex-default-bibliography (quote ("~/Books/References.bib")))
(bind-key* "C-c ]" #'org-ref-helm-insert-cite-link)
(bind-keys :map org-mode-map
("C-c [" . org-ref-helm-insert-ref-link))
(bind-keys :map bibtex-mode-map ("C-c [" . helm-bibtex))
(use-package org-ref
:after org
:config
(add-to-list 'org-ref-bibtex-journal-abbreviations '("PMAG" "Philosophical Magazine" "Philos. Mag."))
(add-to-list 'org-ref-bibtex-journal-abbreviations '("MRSBEA" "MRS Bulletin" "MRS Bull."))
(add-to-list 'org-ref-bibtex-journal-abbreviations '("ExtrMechL" "Extreme Mechanics Letters" "Extreme Mech. Lett."))
(add-to-list 'org-ref-bibtex-journal-abbreviations '("PRMHBS" "Physical Review Materials" "Phys. Rev. Mater."))
))Disable org-ref-setup-label-finders for speed
org-ref-setup-label-finders is taking most of time during Org mode loading. However, according to its docstring, it will be ran by font-lock anyway. Trying to disable org-ref-add-labels call from it and see if anything is broken.
(use-package org-ref
:after org
:config
(defun org-ref-setup-label-finders ()
"Set up the functions for maintaining labels in a buffer."
(setq-local org-ref-labels '())
;; (org-ref-add-labels (point-min) (point-max))
(add-to-list 'jit-lock-functions 'org-ref-add-labels)
(add-to-list 'before-change-functions 'org-ref-delete-labels)))Org-ref-cite
My fork of org-ref-cire providing bibliographies stored in org headings.
(use-package org-ref-cite
:after org
:disabled t
:straight (org-ref-cite :host github :repo "jkitchin/org-ref-cite"
:fork (:host github :repo "yantar92/org-ref-cite")))SOMEDAY search in article PDFs
- need to modify the lib to show abstracts (
recollqq -A)
(use-package helm-recoll
:if init-flag
:straight t
:config
(helm-recoll-create-source "docs" "~/.recoll")
(bind-key* "C-c }" 'helm-recoll-docs))Offer link selection when C-c C-o on a heading
By default, org-offer-links-in-entry does a pretty decent job offering what link to open, but I prefer to list attachment directory as well.
The function is redefined in Use posframe to offer link selection (cannot redefine multiple times using el-patch)
Also, use org-attach-open instead of org-attach-reveal in org-open-at-point.
(define-advice org-open-at-point (:around (oldfun &optional arg) use-org-attach-open)
"Use `org-attach-open' instead of `org-attach-reveal' when opening attachments."
(cl-letf (((symbol-function 'org-attach-reveal) #'org-attach-open)
((symbol-function 'org-attach-reveal-in-emacs) #'org-attach-open-in-emacs))
(org-with-point-at-org-buffer-drop-excursion
(funcall oldfun arg))))
(define-advice org-agenda-open-link (:override (&optional arg) use-org-open-at-point) (org-open-at-point arg))LaTeX integration
CDLaTeX
Additional auto-typing for LaTeX fragments directly inside org. This includes:
- C-c { for inserting environment
- TAB for LaTeX abbrev expansion
- _ and ^ automatically adds curly braces
- ` inserts Greek symbols
- ’ inserts LaTeX accents
(use-package org
:if init-flag
:defer t
:init
(use-package cdlatex
:straight t
:config
(require 'texmathp))
:hook (org-mode . org-cdlatex-mode)
:config
(diminish 'org-cdlatex-mode (s-concat
" "
(propertize "CD"
'face `((:height 0.5)))
(propertize (all-the-icons-fileicon "tex" :v-adjust 0.04)
'face `((
:family "file-icons"
;; :height 1.4
)))))
(diminish 'org-cdlatex-mode)
)Properties
(setq org-use-property-inheritance '("ORG-TIME-BONUS-ON-DONE" "ORG-TIME-BALANCE-MULTIPLIER" "SORT" "SHOWDATES" "SHOWFROMDATE" "SHOWFROMTIME" )):SHOWFROMTIME:(always inheriting)- The purpose of this is to be able to assign specific projects for different days of week or, say, show the home items only in the evening of weekdays and not annoy it at work when I cannot do it any way. Hence, I can focus on the items I really need to do now in this agenda.
Additionally, the time of the day after midnight is treated specially here. If
org-extend-today-untilis not 0 and the current time is before its value, the current time is still considered to be yesterday.(setq org-extend-today-until 4) (setq org-use-effective-time t) ; respect `org-extend-today-until' when setting time-stamps ;; (add-to-list 'org-default-properties "SHOWFROMTIME") (defun org-agenda-skip-before-SHOWFROMTIME-property () "Skip agenda item if :SHOWFROMTIME: property is set and time of day is before it" (when-let ((showfromtime (condition-case nil (org-entry-get-with-inheritance "SHOWFROMTIME" nil (when (boundp 'org-ql--current-element) org-ql--current-element)) (t (org-entry-get-with-inheritance "SHOWFROMTIME" nil))))) (not (yant/now-after-showfromtime? showfromtime))))
:SHOWFROMDATE:- The purpose of this is to be able to postpone the scheduled tasks for future if I cannot do it. The property is formatted as an org date. This property is especially useful if there is something more pressing, so that there is a temptation to reschedule less pressing event to another day. If the more pressing task is done earlier than expected, the postponed tasks can be still find in normal agenda view (not in the focused one).
(require 'org-agenda)
(add-to-list 'org-default-properties "SHOWFROMDATE")
(bind-key "C-c C-f" #'org-command-set-SHOWFROMDATE-property org-mode-map)
(bind-key "C-c C-f" #'org-command-set-SHOWFROMDATE-property org-agenda-mode-map)
(add-to-list 'org-agenda-bulk-custom-functions '(?F org-command-set-SHOWFROMDATE-property))
(defun org-command-set-SHOWFROMDATE-property (&optional arg)
"Command to set :SHOWFROMDATE property for the org entry at point.
If NOT-IN-AGENDA is not nil, do not check whether we are in agenda now."
(interactive "P")
(if (equal major-mode 'org-agenda-mode)
(progn
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(inhibit-read-only t)
ts)
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
;; (org-fold-show-context 'agenda)
(funcall-interactively 'org-command-set-SHOWFROMDATE-property arg)
(setq ts (org-entry-get (point) "SHOWFROMDATE")))
(org-agenda-show-new-time marker ts " P"))))
(let ((property "SHOWFROMDATE"))
(if (equal arg '(4))
(org-entry-delete (point) property)
(let ((value (org-read-property-value property))
(fn (cdr (assoc-string property org-properties-postprocess-alist t))))
(setq org-last-set-property property)
(setq org-last-set-property-value (concat property ": " value))
;; Possibly postprocess the inserted value:
(when fn (setq value (funcall fn value)))
(unless (equal (org-entry-get nil property) value)
(org-entry-put nil property value)))))))
(defun org-set-SHOWFROMDATE-property (PROMPT &rest args)
"Read :SHOWFROMDATE: property."
(org-read-date nil nil nil PROMPT))
(add-to-list 'org-property-set-functions-alist '("SHOWFROMDATE" . org-set-SHOWFROMDATE-property))
(defun org-agenda-skip-before-SHOWFROMDATE-property ()
"Skip agenda item if :SHOWFROMDATE: property is set and the day is before it"
(when-let* ((showfromdate (if (bound-and-true-p org-ql--current-element)
(org-element-property :SHOWFROMDATE (org-element-lineage org-ql--current-element '(headline) t))
(org-entry-get (point) "SHOWFROMDATE")))
(showfromdate (unless (seq-empty-p showfromdate) (ts-parse-org showfromdate)))
(currenttime (ts-now)))
(ts< currenttime showfromdate)))
:SHOWDATES:(always inheriting)- It contains dairy
sexpsto set when the project should be shown. For example, I may want to work on Saturday once or twice, but the working items should not be shown on weekend normally. Hence, I can define it. Or some things can only be done on specific dates (say, going to some shop, which is open few days a week only)(add-to-list 'org-default-properties "SHOWDATES") (defun org-agenda-skip-noshowdates() "Skip agenda item if :SHOWDATES: property sexp is not matching today" (require 'diary-lib) (let* ((entry (condition-case nil (org-entry-get-with-inheritance "SHOWDATES" nil (when (boundp 'org-ql--current-element) org-ql--current-element)) (t (org-entry-get-with-inheritance "SHOWDATES" nil)))) (date (diary-make-date (nth 4 (decode-time)) (nth 3 (decode-time)) (nth 5 (decode-time)))) (result (and entry (pcase (eval (car (read-from-string entry))) ((and (pred listp) res) (cdr res)) (res res))))) ;; Not actual skip function, but used in org-ql-skip (and entry (not result)))) (defun yant/daysofweek (&rest days) "Return 't if any of the listed weekdays (Mon, Tue, Wed, Thu, Fri, Sat, Sun) is today. Work only in the context of :SHOWDATES: property." (defvar entry) (let ((data (list (if (member "Mon" days) '(7 7 24 2017) nil) (if (member "Tue" days) '(7 7 25 2017) nil) (if (member "Wed" days) '(7 7 26 2017) nil) (if (member "Thu" days) '(7 7 27 2017) nil) (if (member "Fri" days) '(7 7 28 2017) nil) (if (member "Sat" days) '(7 7 29 2017) nil) (if (member "Sun" days) '(7 7 30 2017) nil)))) (some #'(lambda (&rest args) (apply #'diary-cyclic (car args))) (remove nil data))))
:CREATED:- Entry creation time. Inserted for all the new captures.
:BLOCKER:- Conditions to be met before allowing the entry to be marked done (see Task inheritance)
:TRIGGER:- Actions to be done when the item is marked done (see Task inheritance)
:MERGED-WITH:- If the task is marked
MERGED, contains a link to the new task :Source:- The link to the file/URL, which this task refers to. This property is also used to unblock the URL when needed (see Distraction-free browsing)
:DISABLE-HOST-BLOCKING:- When set to
t, unblock everything while clocked-in to the task
Attach
- State “NEXT” from “TODO” [2018-09-20 Thu 22:31]
- State “TODO” from “NEXT” [2018-09-20 Thu 22:17]
(use-package org-attach
:after org
:configDefault attachment directory + multi-selection for attach
I try to store every possibe file in an attachment dir.
The new files are usually coming from my Downloads (yant/org-attach-default-source) directory.
(defvar yant/org-attach-default-source "~/Downloads/"
"Default directory to attach the files from.")
(define-advice org-attach-attach (:around (oldfun files &rest args) start-from-default-directory)
"Look for new attachments from `yant/org-attach-default-source' directory instead of `default-directory'."
(interactive
(list
(mapcar #'directory-file-name (helm-read-file-name "File to keep as an attachment:"
:initial-input (or (progn
(require 'dired-aux)
(dired-dwim-target-directory))
(and yant/org-attach-default-source
(f-slash yant/org-attach-default-source))
default-directory)
:marked-candidates t))
current-prefix-arg
nil))
(unless (listp files) (setq files (list files)))
(mapc (lambda (file) (apply oldfun file args)) files))Make it possible to attach directories (not only files)
The default org-attach-attach function does not allow to attach directories.
I made it so in the interactive specification in Default attachment directory.
Automatically insert link at point after adding new attachment
The most common scenario working with attachments is when I want to add an attachment and immidiately insert the corresponding attachment: link.
So, it makes sense to copy the link to added attachment into link ring.
(use-package org-attach
:if init-flag
:after org
:custom
(org-attach-store-link-p 'attached))HOLD Store files in folder structure, following my org tree structure
- State “HOLD” from “NEXT” [2020-09-05 Sat 14:34]
After org-fold - State “TODO” from “NEXT” [2018-01-01 Mon 13:17]
I usually have a huge numbers of files, related to my projects. I would like to use attach to associate the files with the proper entry, but searching them later in my Dropbox is a pain because of the way Org saves the attachments. It makes more sense for me to make attachments follow the org tree structure in the project by default (unless I change the attach folder to something else).
This can be done if we make attachment by creating a symbolic link to the attach folder in the place, according to the headline path. This way allows to keep all the file attached to the project accessible with relative paths.
I do not handle the situation when the entry uid is being changed.. Try to look in symlinks?ENDFor the implementation, the idea is keeping all the actual attachments in a common folder for all the org files according to their uuid. As a result, I can safely refile tasks between different org files without worrying about moving the attachments around (assuming that there is not change in the task ids).
(put 'yant/org-attach-file-symlink-path 'safe-local-variable 'stringp)
(use-package org-attach-fs
:disabled
:straight (org-attach-fs :local-repo "~/Git/org-attach-fs")
:after org
:demand t)This is separate package now. All the code below is exported to org-attach-fs.el
;;; org-attach-fs.el --- Mirror org heading heirarchy to store attachments
;; Version: 0.0
;; Author: Ihor Radchenko <yantar92@gmail.com>
;; Created: 14 March 2020
;;; Commentary:
;; This package aims to store symlinks to org attachments under folder
;; structure reflecting current org heading hierarchy.
;; The package started as my personal Emacs config and assumes that
;; all the attachments can be accessed from any org file. This
;; corresponds to the following config:
;; (setq org-attach-method 'mv)
;; (setq org-attach-id-dir "~/.data/")
;; (setq org-id-locations-file
;; (f-join org-attach-id-dir ".org-id-locations"))(require 'f)
(require 'org-attach)(setq org-attach-method 'mv)
(setq org-attach-id-dir "~/.data/")
(setq org-id-locations-file
(f-join org-attach-id-dir ".org-id-locations"))The above does not follow the task hierarchy of the tasks.
To implement this, for each task, I store the symlinks to the child tasks in the task’s attachment directory.
Therefore, apart from the attachments, I have yant/org-attach-symlinks-directory folder in the task’s attach dir.
This folder contains a back reference to the attachment dir (if there are attachments) yant/org-attach-attachments-symlink-directory and symlinks to the corresponding symlink folders of the children with attachments somewhere down the hierarchy.
Now, it is trivial to create the attachment hierarchy for any org file. I just make folders pointing to the yant/org-attach-symlinks-directory of the top level tasks either in the same folder with the org file or in yant/org-attach-file-symlink-path (file local).
;; (setq org-attach-file-list-property nil)
(defvar-local yant/org-attach-file-symlink-path nil
"Path to directory where the symlink hierarchy is created for the current org buffer.
It is intended to be set as a file-local variable.
Use `default-directory' if nil.")
(put 'yant/org-attach-file-symlink-path 'safe-local-variable 'stringp)
(defvar yant/org-attach-attachments-symlink-directory "_data"
"Name of the symlink to the attach file folder.")
(defvar yant/org-attach-symlinks-directory ".org.symlinks"
"Name of the folder containing symlinks to the entry children attach folders.")
(define-advice org-attach-file-list (:filter-return (filelist) remove-boring-files)
"Remove local variable file and boring symlinks from the attachment file list."
(let ((symlinks-directory yant/org-attach-symlinks-directory))
(remove "flycheck_.dir-locals.el" ;; not sure where this constant is defined
(remove dir-locals-file
(remove symlinks-directory
filelist)))))
(defun yant/outline-get-next-sibling (&optional subtree-end)
"A faster version of `outline-get-next-sibling'.
Bound search by SUBTREE-END if non nil."
(let* ((level (funcall outline-level))
(sibling-regex (concat "^\\*\\{" (format "%d" level) "\\}[^*]"))
(bound (or subtree-end (point-max))))
(re-search-forward sibling-regex bound 'noerror)))
(defun yant/org-entry-name-cleanup-for-dir ()
"Format entry name to make a directory. Return nil if the entry name is empty."
(org-with-wide-buffer
(let* ((entry-name (replace-regexp-in-string "[/<>|:&/]" "-" ;; make sure that entry title can be used as a directory name
(org-get-heading 'NO-TAGS 'NO-TODO 'NO-PRIORITY 'NO-COMMENT)))
(entry-name (replace-regexp-in-string " +\\[.+\\]$" "" ;; remove statistics cookies
entry-name
))
(entry-name (replace-regexp-in-string org-link-bracket-re "\\2" ;; only leave the link names
entry-name
)))
(unless (seq-empty-p entry-name) ;; prevent empty folders
(set-text-properties 0 (length entry-name) nil entry-name)
entry-name))))
(defun yant/org-subtree-has-attachments-p ()
"Return non nil if the subtree at point has an attached file."
(org-with-wide-buffer
(when (eq major-mode 'org-mode) (org-back-to-heading))
(let ((subtree-end (save-excursion (org-end-of-subtree))))
(re-search-forward (format "^\\*+ +.*?[ ]+.*?:%s:.*?$" org-attach-auto-tag) subtree-end 'noerror))))
(defun yant/org-task-has-attachments-p ()
"Return non nil if the task at point has an attached file."
(org-with-wide-buffer
(when (eq major-mode 'org-mode) (org-back-to-heading))
(or (member org-attach-auto-tag (org-get-tags nil t))
(let ((dir (let ((org-attach-dir-suppress-extra-checks t)) (org-attach-dir))))
(and dir
(org-attach-file-list dir))))))
(defvar yant/--processed-entry-ids nil
"Variable used to store processed entry ids in `org-attach-dir@yant/org-attach-ensure-attach-dir-symlink'")
(define-advice org-attach-dir (:filter-return (dir) yant/org-attach-ensure-attach-dir-symlink)
"Make sure that the attach DIR for the current entry has a link in the org structure based directory structure.
The DIR is ensured to be in the symlink mirror dir structure for the entry.
Do nothing if `org-attach-dir-suppress-extra-checks' is non-nil."
(prog1
(and dir
(f-slash dir))
(when (and (equal major-mode 'org-mode)
dir
(not (bound-and-true-p org-attach-dir-suppress-extra-checks)) ;; an option to make `org-attach-dir' faster if needed
(f-exists-p dir)
(f-dir-p dir))
(let* ((attach-path dir)
(symlinks-directory (f-slash (f-join dir
yant/org-attach-symlinks-directory)))
(attachments-symlink-directory (f-slash (f-join symlinks-directory
yant/org-attach-attachments-symlink-directory)))
(org-id (org-id-get nil 'create))
(entry-name (yant/org-entry-name-cleanup-for-dir))
(attach-dir-inherited-p (or (not (org-entry-get (point) "ID"))
(and (org-entry-get-with-inheritance "DIR")
(not (org-entry-get (point) "DIR")))
(and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))))) ;; only consider if the entry is the child
(org-attach-dir-recursive-p (bound-and-true-p org-attach-dir-recursive-p))) ;; keep track if this is the initial call of the function
(unless org-attach-dir-recursive-p (setq yant/--processed-entry-ids nil))
(unless (member org-id yant/--processed-entry-ids)
(add-to-list 'yant/--processed-entry-ids org-id)
(unless attach-dir-inherited-p
(when (f-file-p symlinks-directory)
(error (format "File exist in place of dir: %s" symlinks-directory)))
(when (and (f-exists-p attachments-symlink-directory)
(not (f-symlink-p (directory-file-name attachments-symlink-directory))))
(error (format "Not a symlink: %s" attachments-symlink-directory)))
;; update dirs
(unless (f-exists-p symlinks-directory)
(f-mkdir symlinks-directory))
(unless (or (f-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
;;(debug)
(f-symlink attach-path (directory-file-name attachments-symlink-directory)))
(when (and (f-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
(f-delete (directory-file-name attachments-symlink-directory)))
;; add to parent entry attachment dir
(unless (seq-empty-p entry-name) ;; prevent empty folder names
(org-with-wide-buffer
(let ((entry-symlink-name (if (org-up-heading-safe)
(directory-file-name (f-join (let ((org-attach-dir-recursive-p t))
(org-attach-dir 'CREATE))
yant/org-attach-symlinks-directory
entry-name))
(or yant/org-attach-file-symlink-path (hack-local-variables))
(when yant/org-attach-file-symlink-path
(unless (file-exists-p yant/org-attach-file-symlink-path) (f-mkdir yant/org-attach-file-symlink-path)))
(directory-file-name (f-join (or yant/org-attach-file-symlink-path
default-directory)
entry-name)))))
(if (not (f-exists-p entry-symlink-name))
(progn
;;(debug)
(f-symlink symlinks-directory (directory-file-name entry-symlink-name)))
(unless (f-symlink-p entry-symlink-name)
(error (format "File exists: %s" entry-symlink-name)))))))
;; check children
(when (yant/org-subtree-has-attachments-p)
(let ((dirs (delete (directory-file-name attachments-symlink-directory)
(f-directories symlinks-directory))))
(org-with-wide-buffer
(org-back-to-heading)
(let ((subtree-end (save-excursion (org-end-of-subtree))))
(forward-line 1)
(when (re-search-forward org-heading-regexp subtree-end t)
(while (< (point) subtree-end)
(when (yant/org-entry-name-cleanup-for-dir)
(let ((child-dir (f-join symlinks-directory (yant/org-entry-name-cleanup-for-dir))))
(when (yant/org-subtree-has-attachments-p)
(unless (member child-dir dirs)
(let ((org-attach-dir-recursive-p t))
(org-attach-dir 'CREATE)))
(setq dirs (delete child-dir dirs)))))
(or (yant/outline-get-next-sibling subtree-end)
(goto-char subtree-end))))))
(mapc (lambda (d)
(let ((dir (f-long d)))
(when (f-symlink-p (directory-file-name dir))
(f-delete dir) ; delete the dirs, which do not point to children
)))
dirs)))))))))
(advice-remove 'org-attach-dir #'org-attach-dir@yant/org-attach-ensure-attach-dir-symlink)Now, when I have the mirror attach folder structure, it make sense to open this structure on org-attach-reveal instead of opening the actual attach dirs.
- State “HOLD” from “NEXT” [2020-05-30 Sat 14:24]
(defun org-attach-dir-symlink (&optional create-if-not-exists-p no-fs-check no-data-dir)
"Return symlink based path to the attach dir of current entry.
Do not append symlink to data directory if NO-DATA-dir is not nil."
(org-with-point-at-org-buffer
(when create-if-not-exists-p
(let ((symlink (org-attach-dir-symlink nil nil no-data-dir)))
(when (not (f-exists-p symlink))
(org-attach-dir 't))
symlink))
(let* ((entry-name (yant/org-entry-name-cleanup-for-dir))
(attach-dir-inherited-p (and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))));; only consider if the entry is the child
(entry-path (and entry-name
(f-join entry-name (if no-data-dir "" yant/org-attach-attachments-symlink-directory)))))
(if attach-dir-inherited-p
(org-with-wide-buffer
(org-up-heading-safe) ;; if this is false, something went really wrong
(org-attach-dir-symlink create-if-not-exists-p nil no-data-dir))
(unless (seq-empty-p entry-name) ;; prevent empty folders
(org-with-wide-buffer
(if (org-up-heading-safe)
(let ((head-path (org-attach-dir-symlink create-if-not-exists-p nil 't)))
(when head-path (f-slash (f-join head-path entry-path))))
(f-slash (f-join (or yant/org-attach-file-symlink-path
default-directory)
entry-path)))))))))
(define-advice org-attach-reveal (:around (OLDFUN) reveal-symlink)
"Go to symlink attach dir structure instead of an actual attach dir."
(let ((dir (org-attach-dir-get-create))
(attach-dir-inherited-p (and (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT")
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))));; only consider if the entry is the child
)
;; (org-attach-dir@yant/org-attach-ensure-attach-dir-symlink dir)
(org-attach-sync)
;; (cl-letf (((symbol-function 'org-attach-dir-get-create) (if (yant/org-task-has-attachments-p)
;; (lambda (&rest args) (org-attach-dir-symlink 't nil nil))
;; (lambda (&rest args)
;; (if (yant/org-subtree-has-attachments-p)
;; (org-attach-dir-symlink 't nil 't)
;; dir
;; )))))
;; (when attach-dir-inherited-p (org-attach-tag 'off))
;; (funcall OLDFUN))
(when attach-dir-inherited-p (org-attach-tag 'off))
(funcall OLDFUN)
))
(advice-remove 'org-attach-reveal #'org-attach-reveal@reveal-symlink)
;; (advice-add 'org-attach-reveal-in-emacs :around #'org-attach-reveal@reveal-symlink)Files, out of the folder structure, will appear in my agenda to attach them to the relevant project (unless explicitly specified in special variable).
implement thisEND(provide 'org-attach-fs)
;;; org-attach-fs.el ends here
handle cases when we need files in the same dir with the org file LaTeX class
SOMEDAY in org-attach, put the attachments directly into symlink if no children of the entry
- State “NEXT” from “TODO” [2018-08-27 Mon 08:39]
Do not abbreviate file names (to avoid strange folders defined in org attachments)
- Refiled on [2020-04-09 Thu 17:42]
(add-hook 'after-init-hook (lambda ()
(advice-add 'find-file-noselect :around #'dired-find-file@disable-abbreviate-file-name)))Make :ATTACH_DIR_INHERITED: work again
- State “DONE” from “NEXT” [2020-08-11 Tue 22:10]
- State “NEXT” from “HOLD” [2020-08-11 Tue 22:10]
(define-advice org-attach-dir (:filter-return (dir) yant/org-attach-use-attach-dir-inheritance -100)
"Use :ATTACH_DIR_INHERIT: property."
(let ((attach-dir-inherited (and (not (string= "nil" (org-entry-get-with-inheritance "ATTACH_DIR_INHERIT" t)))
(not (org-entry-get (point) "ATTACH_DIR_INHERIT" nil))
(org-with-point-at org-entry-property-inherited-from (org-attach-dir t)))))
(or attach-dir-inherited
dir)))
;; (advice-remove 'org-attach-dir #'org-attach-dir@yant/org-attach-use-attach-dir-inheritance)Saving web pages into notes
- State “DONE” from “NEXT” [2018-09-06 Thu 20:53]
- State “TODO” from [2017-12-30 Sat 22:20]
Sometimes, I want to save certain interesting online articles to disk to make sure that all the content and comments are preserved regardless of the website changes.
_epilogue
)Agenda & scheduling
(require 'org-agenda)
(setq org-agenda-skip-scheduled-delay-if-deadline t)
(setq org-agenda-restore-windows-after-quit t)
(setq org-agenda-window-setup 'only-window)
(setq org-agenda-todo-list-sublevels t)
(setq org-agenda-show-inherited-tags t)
(setq org-agenda-search-headline-for-time nil)
(setq org-agenda-use-time-grid nil)
(setq org-directory "~/Org")
(setq org-agenda-files "~/Org/agenda_files")
(setq org-deadline-warning-days 30)
(setq org-agenda-span 'day)
(setq org-agenda-sorting-strategy '((agenda deadline-down time-up habit-up priority-down timestamp-down category-keep)
(todo priority-down category-keep)
(tags priority-down category-keep)
(search category-keep)))
(setq org-agenda-tags-todo-honor-ignore-options t)
(setf org-agenda-sticky t)
(setq org-agenda-skip-scheduled-if-deadline-is-shown t
org-agenda-skip-deadline-prewarning-if-scheduled t)
(setq org-habit-show-habits-only-for-today t) ; do not show habits in future if scheduled withing agenda time range. E.g. do not show future habits in week view/calendarAgendas is my main entry point into daily work. This is where I pickup tasks to work on during the day. I generally use a combination of GTD and “Eating Live Frogs: Do the Worst Thing First” (see Rainer König: Orgmode-TV: How do I plan my days, The Ultimate Guide to Personal Productivity Methods), though I am not disciplined enough to follow the latter precisely. In addition, I sometimes use Pomodoro, Time blocking (kind of), and Bonus/penalty based time management. These methods works fine for me at this point, though many more methods do exist The Ultimate Guide to Personal Productivity Methods.
- I use several agenda views
- Focused daily agenda
- When we mark the item scheduled, it means that we need to start working on it from that day. However, it leads to a situation when there are so many items being active in agenda that it is useful to focus on what we need to do during the day. That’s why I need an additional agenda which focuses on what I really need to do today, but not what I need to start today and what I have started to do which is the case for default daily agenda. See Focused daily agenda.
Indeed, this agenda may as well grow over time. So, I always try to keep it as short as possible: just daily chores + really important things I need to work on. If this agenda grows too much, I consider marking some tasks as HOLD or WAITING and come back to them when I finish the more important tasks. Ideally, there should be no more than 3 big tasks (not chores) to work on each day. Similar concepts are discussed in Dave Lee — GTD sucks for creative work. Here’s an…
- Normal daily agenda
- Standard agenda with minor tweaks. A can work on it when/if I finish with focused agenda.
- Inbox agenda view for captured tasks
- The new tasks and notes I added recently. They must be refiled somewhere. I am not trying to do tasks from here rightaway, but rather just classify the tasks to look at them later in appropriate time. For example, looking into some youtube bookmarks rightaway would not be wise.
- Hanging tasks
- The new tasks, which have been refiled, but I did not look into details yet. For example, there can be some online bookmarks I plan to look into, but I only looked into their title so far. I will need some small time to decide if I even want to work on those and when I want to do it. This is the lowest priority agenda during a day. I may or may not look into it on daily basis.
- Full agenda for GTD self-check
- see GTD self-check.
- List of projects agenda
- List of all active projects.
I use different skip functions here in agenda to filter the agenda. Some of them are used, some of them are just kept here for future if I need them.
(defun yant/skip-non-stuck-projects-and-non-next-subprojects ()
"Skip trees that are not stuck projects"
(yant/org-agenda-skip-org-ql '(and (project)
(not (todo "SOMEDAY" "TODO"))
(or (todo "NEXT" "REVIEW" "DOING")
(not (subproject)))
(not (tags "HOLD" "CANCELLED" "WAITING"))
(not (and (tags-local "AREA")
(not (descendants (todo)))))
(not (descendants
(and (todo "NEXT" "REVIEW" "DOING")
(not (tags "WAITING" "CANCELLED" "HOLD" "SOMEDAY"))
))))))
(defun bh/skip-non-stuck-projects-and-non-next-subprojects ()
"Skip trees that are not stuck projects"
;; (bh/list-sublevels-for-projects-indented)
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))
(area-p (member "AREA" (org-get-tags nil 'local))))
; (if (bh/is-project-p)
(if (and (bh/is-project-p)
(not (member (org-get-todo-state) (list "SOMEDAY" "TODO")))
(or (not (bh/is-subproject-p))
(member (org-get-todo-state) (list "NEXT"
"REVIEW"
"DOING"))))
(let* ((subtree-end (save-excursion (org-end-of-subtree t)))
(has-next)
has-todo)
(save-excursion
(forward-line 1)
(while (and (not has-next) (< (point) subtree-end) (re-search-forward org-not-done-heading-regexp subtree-end t))
(unless (or (member "WAITING" (org-get-tags nil))
(member "CANCELLED" (org-get-tags nil))
(member "HOLD" (org-get-tags nil))
(member "SOMEDAY" (org-get-tags nil)))
(setq has-todo t)
(when (member (org-get-todo-state) (list "NEXT" "REVIEW" "DOING"))
(setq has-next t)))))
(if (or has-next
(and (not has-todo)
area-p))
next-headline
nil)) ; a stuck project, has subtasks but no next task
next-headline))))
(defun bh/skip-non-projects ()
"Skip trees that are not projects"
;; (bh/list-sublevels-for-projects-indented)
;; (if (save-restriction (bh/skip-non-stuck-projects-and-non-next-subprojects))
(save-restriction
(widen)
(let ((subtree-end (save-excursion (org-end-of-subtree t))))
(cond
((and (bh/is-project-p)
(or (member "project" (org-get-tags-at nil 'local))
(not (bh/is-subproject-p))))
nil)
(t
subtree-end)))
))
(defun bh/skip-projects ()
"Skip trees that are projects"
(save-restriction
(widen)
(let ((subtree-end (save-excursion (org-end-of-subtree t))))
(cond
((bh/is-project-p)
subtree-end)
(t
nil)))
))
(defun bh/skip-non-tasks ()
"Show non-project tasks.
Skip project and sub-project tasks, habits, and project related tasks."
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(cond
((bh/is-task-p)
nil)
(t
next-headline)))))
(defun bh/skip-subprojects ()
"Show non-subproject tasks.
Skip project and sub-project tasks, habits, and project related tasks."
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(cond
((not (bh/is-subproject-p))
nil)
(t
next-headline)))))
(defun yant/org-is-habit-p (&optional subtree-end pom)
"Faster implementation of `org-is-habit-p'.
Returns t if entry at POM is habit.
SUBTREE-END is used as end of the entry if not nil."
(save-excursion
(and pom (goto-char pom))
(re-search-forward "^ *:STYLE: +habit"
(or subtree-end
(save-excursion (or (outline-next-heading) (point-max))))
t)))
(defun bh/skip-habits ()
"Skip habits"
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(if (yant/org-is-habit-p next-headline)
next-headline
nil))))
(defun bh/skip-nohabits ()
"Skip not habits."
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(if (yant/org-is-habit-p next-headline)
nil
next-headline))))
(defun yant/skip-projects-and-habits-and-single-tasks ()
"Skip trees that are projects, tasks that are habits, single non-project tasks"
(yant/org-agenda-skip-org-ql '(and (not (habit))
(subtask)
(not (project)))))
(defun bh/skip-projects-and-habits-and-single-tasks ()
"Skip trees that are projects, tasks that are habits, single non-project tasks"
(save-restriction
(widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(cond
((org-is-habit-p)
next-headline)
((and bh/hide-scheduled-and-waiting-next-tasks
(member "WAITING" (org-get-tags nil t)))
next-headline)
((bh/is-project-p)
next-headline)
((and (bh/is-task-p) (not (bh/is-project-subtree-p)))
next-headline)
(t
nil)))))
(defun zin/org-agenda-skip-tag (tag &optional others local)
"Skip all entries that correspond to TAG.
If OTHERS is true, skip all entries that do not correspond to TAG.
If LOCAL is non-nil, check only local TAG."
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(if others
(if (not (member tag (org-get-tags nil local)))
next-headline
nil)
(if (member tag (org-get-tags nil local))
next-headline
nil))))(set-face-attribute 'org-agenda-structure nil
:height 120
:foreground "firebrick")
(set-face-attribute 'org-agenda-date-today nil
:foreground "dark goldenrod")
(defvar bh/hide-scheduled-and-waiting-next-tasks 't)
(setq org-agenda-skip-function nil)
(use-package org-ql
:defer t
:config
(org-ql-defpred-alias goal ()
"Match a goal."
(tags-local "goal"))
(org-ql-defpred-alias area ()
"Match an area."
(tags-local "AREA")))
(setq org-agenda-custom-commands
(quote (("a" "Full agenda"
agenda ""
((org-agenda-tag-filter-preset '("-TICKLER" "-CANCELLED" "-WAITING" "-HOLD" "-SOMEDAY" "-NODEADLINE"))
(org-agenda-regexp-filter-preset '("-TICKLER"))))
("s" nil
agenda ""
((org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (not (done))
(ts-active)
(not (tags-inherited "HOLD" "WAITING" "CANCELLED"))
(not (tags "SOMEDAY"))
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(not (org-agenda-skip-before-SHOWFROMTIME-property))
(not (org-agenda-skip-noshowdates))))))))
("p" "Projects"
((tags-todo "/"
((org-agenda-overriding-header "Active projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (not (tags "SOMEDAY" "HOLD" "WAITING" "CANCELLED"))
(not (todo "TODO"))
(not (area))
(not (goal))
(project)
(not (subproject))))))
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Waiting and Hold projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (not (tags "CANCELLED" "SOMEDAY"))
(not (and (tags-local "WAITING")
(tags-local "TRACK")))
(not (area))
(not (todo "TODO"))
(not (tags-inherited "HOLD" "WAITING"))
(tags-local "HOLD" "WAITING")
(project)
;; (not (subproject))
))))
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Someday projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (tags-local "SOMEDAY")
(not (tags "CANCELLED"))
(not (area))
(project)
;; (not (subproject))
))))
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Hanging projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "TODO")
(not (tags "CANCELLED"))
(not (area))
(project)
(not (subproject))))))
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))))
("A" "Areas of interest" tags-todo "-CANCELLED+AREA"
((org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
;; (org-agenda-skip-function 'bh/skip-non-projects)
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))
("d" "Focus daily agenda" agenda ""
((org-agenda-overriding-header "Focused daily agenda")
(org-agenda-skip-function 'yant/org-agenda-skip-nofocus)))
("i" "Inbox items"
((tags "+INBOX-DEFAULT"
((org-agenda-overriding-header "Inbox\n")
(org-agenda-files '("~/Org/inbox.org"))
(org-agenda-skip-function '(or (yant/org-agenda-inbox-items) (org-agenda-skip-entry-if 'notscheduled)))
(org-agenda-prefix-format "S\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))
(tags "+INBOX-DEFAULT"
((org-agenda-overriding-header "")
(org-agenda-files '("~/Org/inbox.org"))
(org-agenda-block-separator nil)
(org-agenda-skip-function '(or (yant/org-agenda-inbox-items) (org-agenda-skip-entry-if 'notdeadline)))
(org-agenda-prefix-format "D\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))
(tags "+INBOX-DEFAULT"
((org-agenda-overriding-header "")
(org-agenda-files '("~/Org/inbox.org"))
(org-agenda-block-separator nil)
(org-agenda-skip-function '(or (yant/org-agenda-inbox-items) (org-agenda-skip-entry-if 'scheduled 'deadline)))
(org-agenda-prefix-format "\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))))
("h" "Hanging tasks"
((tags-todo "/"
((org-agenda-overriding-header "All other active tasks")
(org-agenda-dim-blocked-tasks 'invisible)
(org-agenda-prefix-format "[%e] %-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "TODO")
(not (tags "CANCELLED" "WAITING" "HOLD" "DEFAULT" "SOMEDAY"))
(or (tags "SKIP")
(tags "NODEADLINE")
(not (subtask)))
(not (habit))
(not (goal))
(task)
))))))))
("w" "Waiting and hold tasks"
((tags-todo "-CANCELLED-SOMEDAY+WAITING-TRACK|-CANCELLED-SOMEDAY+HOLD"
((org-agenda-overriding-header (concat "Waiting and Hold Tasks (excluding tracked tasks)" ""))
(org-agenda-prefix-format "%-12:c\t%?-12t %(yant/format-summary-for-agenda)")
(org-use-tag-inheritance nil)
(org-agenda-skip-function 'bh/skip-projects)
(org-tags-match-list-sublevels nil)
(org-agenda-sorting-strategy
'(todo-state-down))))))
("n" "Agenda, NEXT, and REVIEW tasks"
((agenda nil
((org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (ts-active :to today)
(not (done))
(not (tags-inherited "HOLD"))
(not (tags-inherited "WAITING"))
(not (tags-inherited "CANCELLED"))
(not (tags "SOMEDAY"))
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(not (org-agenda-skip-before-SHOWFROMTIME-property))
(not (org-agenda-skip-noshowdates))))))))
(tags-todo "/"
((org-agenda-overriding-header "Tasks to review")
(org-agenda-dim-blocked-tasks 'invisible)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "REVIEW")
(not (tags "CANCELLED" "WAITING" "HOLD" "DEFAULT" "SOMEDAY"))))))))
(tags-todo "/"
((org-agenda-overriding-header (concat "Project Next Tasks"
(if bh/hide-scheduled-and-waiting-next-tasks
""
" (including WAITING and SCHEDULED tasks)")))
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote
(and (todo "NEXT")
(not (tags "CANCELLED" "HOLD" "WAITING" "NODEADLINE" "SOMEDAY" "AREA" "DEFAULT"))
(not (tags-local "SKIP"))
(not (habit))
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(not (project))
(not (goal))
(not (area))
;; (subtask)
(not (ancestors (todo "TODO")))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-deadlines bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-with-date bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header (concat "Extra Next Tasks"
(if bh/hide-scheduled-and-waiting-next-tasks
""
" (including WAITING and SCHEDULED tasks)")))
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote
(and (todo "NEXT")
(tags "NODEADLINE")
(not (tags-local "SKIP"))
(not (tags "CANCELLED" "HOLD" "WAITING" "SOMEDAY" "AREA" "DEFAULT"))
(not (habit))
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(not (project))
(not (goal))
(not (area))
;; (subtask)
(not (ancestors (todo "TODO")))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-deadlines bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-with-date bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Stuck Projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (or (project) (area))
(not (todo "SOMEDAY" "TODO"))
(or (todo "NEXT" "REVIEW" "DOING")
(not (subproject)))
(not (tags "CANCELLED" "WAITING" "HOLD" "SOMEDAY"))
(not (and (area)
(or (not (descendants (todo)))
(descendants (todo "TODO")))))
(not (goal))
(not (descendants
(and (todo "NEXT" "REVIEW" "DOING")
(not (tags "WAITING" "CANCELLED" "HOLD" "SOMEDAY"))
)))))))
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Tasks in progress")
(org-agenda-prefix-format "[%e] %-12:c\t%?-12t")
(org-tags-match-list-sublevels t)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "DOING")
(not (tags "CANCELLED" "HOLD" "WAITING" "SOMEDAY"))))))
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))))
("v" "GTD overview"
((agenda ""
((org-agenda-prefix-format "%-12s\t%-12:c\t%?-12t")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (ts-active)
(todo)
(not (tags-inherited "HOLD"))
(not (tags-inherited "WAITING"))
(not (tags-inherited "CANCELLED"))
(not (tags "SOMEDAY"))))))))
(tags-todo "/"
((org-agenda-overriding-header "Inbox")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (scheduled)
(tags "INBOX")
(not (tags "DEFAULT"))))))
(org-agenda-prefix-format "S\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))
(tags-todo "/"
((org-agenda-overriding-header "")
(org-agenda-block-separator nil)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (deadline)
(tags "INBOX")
(not (tags "DEFAULT"))))))
(org-agenda-prefix-format "D\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))
(tags-todo "/"
((org-agenda-overriding-header "")
(org-agenda-block-separator nil)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (not (scheduled))
(not (deadline))
(tags "INBOX")
(not (tags "DEFAULT"))))))
(org-agenda-prefix-format "\t\t%-12:c\t%?-12t")
(org-tags-match-list-sublevels nil)))
(tags "/"
((org-agenda-overriding-header "Tasks to Archive")
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-skip-function 'yant/skip-non-archivable-tasks)
(org-tags-match-list-sublevels nil)))
(tags-todo "/"
((org-agenda-overriding-header "Stuck Projects")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (or (project) (area))
(not (todo "SOMEDAY" "TODO"))
(or (todo "NEXT" "REVIEW" "DOING")
(not (subproject)))
(not (tags "CANCELLED" "WAITING" "HOLD" "SOMEDAY"))
(not (and (area)
(or (not (descendants (todo)))
(descendants (todo "TODO")))))
(not (goal))
(not (descendants
(and (todo "NEXT" "REVIEW" "DOING")
(not (tags "WAITING" "CANCELLED" "HOLD" "SOMEDAY"))
)))))))
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(category-keep))))
(tags-todo "/"
((org-agenda-overriding-header (concat "Waiting and Hold Tasks" ""))
(org-agenda-prefix-format "%-12:c\t%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (not (scheduled))
(or (tags-local "HOLD")
(and (tags-local "WAITING")
(not (tags-local "TRACK"))))
(not (tags-inherited "HOLD" "WAITING"))
(not (tags "CANCELLED" "SOMEDAY"))
(task)))))
;; (org-agenda-skip-function '(or (bh/skip-projects)
;; (org-agenda-skip-entry-if 'scheduled)))
(org-tags-match-list-sublevels nil)
(org-agenda-sorting-strategy
'(todo-state-down))))
(tags-todo "/"
((org-agenda-overriding-header (concat "Project Next Tasks"
(if bh/hide-scheduled-and-waiting-next-tasks
""
" (including WAITING and SCHEDULED tasks)")))
(org-agenda-prefix-format "[%e] %-12:c\t%?-12t")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote
(and (todo "NEXT")
(not (tags "CANCELLED" "HOLD" "WAITING" "NODEADLINE" "SOMEDAY" "AREA" "DEFAULT"))
(not (tags-local "SKIP"))
(not (habit))
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(not (project))
(not (goal))
(not (area))
;; (subtask)
(not (ancestors (todo "TODO")))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-deadlines bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-with-date bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header (concat "Extra Next Tasks"
(if bh/hide-scheduled-and-waiting-next-tasks
""
" (including WAITING and SCHEDULED tasks)")))
(org-agenda-prefix-format "[%e] %-12:c\t%?-12t")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote
(and (todo "NEXT")
(tags "NODEADLINE")
(not (tags-local "SKIP"))
(not (tags "CANCELLED" "HOLD" "WAITING" "SOMEDAY" "AREA"))
(not (habit))
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(subtask)
(not (project))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-deadlines bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-todo-ignore-with-date bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Tasks to review")
(org-agenda-dim-blocked-tasks 'invisible)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "REVIEW")
(not (tags "CANCELLED" "WAITING" "HOLD" "DEFAULT" "SOMEDAY"))))))))
(tags-todo "/"
((org-agenda-overriding-header "Areas of interest")
(org-agenda-dim-blocked-tasks nil)
(org-agenda-prefix-format "%?-12t %(yant/format-summary-for-agenda)")
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (tags-local "AREA")
(not (tags-inherited "SOMEDAY"))
(not (descendants
(and (tags-local "AREA")
(todo "NEXT"))))))))
(org-agenda-sorting-strategy
'(todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "All other active tasks")
(org-agenda-dim-blocked-tasks 'invisible)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo)
(not (habit))
(not (goal))
(task)
(or (tags "SKIP")
(not (subtask)))
(not (tags "CANCELLED" "WAITING" "HOLD" "DEFAULT" "SOMEDAY" "NODEADLINE"))))))))
(tags-todo "/"
((org-agenda-overriding-header "Someday tasks outside projects")
(org-agenda-dim-blocked-tasks 'invisible)
(org-agenda-prefix-format "%-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled bh/hide-scheduled-and-waiting-next-tasks)
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (todo "SOMEDAY")
(task)
(not (habit))
(not (subtask))
(not (tags "CANCELLED" "WAITING" "HOLD" "DEFAULT" "NODEADLINE"))
)))))))
nil))))Location contexts
Every agenda view is filtered by location context.
By location context, I mean tags like @home, @work, @meeting, etc
The tags imply that the tagged tasks can only be done when I am physically located in certain place.
Every time I build a new agenda (but not when I update it), I am asked about the current location context (from the list of available @* tags in agenda).
Also, no contexts are prompted in Inbox agenda.
(use-package org-agenda
:if init-flag
:after org
:config
(add-hook 'org-agenda-finalize-hook #'yant/org-agenda-filter-by-location-context)
(setq org-agenda-persistent-filter t)
(defun yant/org-agenda-filter-by-location-context ()
"Filter current agenda by location context.
This command offers all the @* tags.
Only items without any @* tags and the items with selected @* tags will be shown in agenda."
(interactive)
(unless (eq major-mode 'org-agenda-mode) (user-error "Cannot run %s outside agenda view" this-command))
(when (and (memq this-command '(org-agenda yant/org-agenda-filter-by-location-context))
(not (string= org-agenda-name "Inbox items"))
(not (string= org-agenda-name "Hanging tasks"))
(not (bound-and-true-p org-agenda-skip-location-context)))
(unless (local-variable-p 'org-global-tags-completion-table)
(setq-local org-global-tags-completion-table
(org-global-tags-completion-table)))
(let ((location-tags (seq-filter (apply-partially #'s-matches-p "^@.+") (mapcar #'car org-global-tags-completion-table)))
tags
tag-filter)
(let ((completion-ignore-case t))
(setq tags (helm-comp-read
"Tags: " location-tags :must-match t :name "Select location context")))
(when tags
(unless (listp tags) (setq tags (list tags)))
(let ((tags-exclude (seq-difference location-tags tags)))
(when tags-exclude
(setq org-agenda-tag-filter (mapcar (lambda (tag)
(concat "-" tag))
tags-exclude))
(org-agenda-filter-apply org-agenda-tag-filter 'tag t))))))))Filtering items in agenda views
By default, filtering commands in agenda replace the currently active filter. Adding/changing the filter is done with C-u C-u argument. I prefer the opposite behaviour when the current filter is changed by default and replaced with C-u C-u.
(use-package org-agenda
:if init-flag
:after org
:config
(define-advice org-agenda-filter (:filter-args (&optional strip-or-accumulate) inverse-filter-modification)
"Modify filter by default."
(setq strip-or-accumulate
(pcase strip-or-accumulate
('(16) nil)
('(nil) '(16))
(other other)))
(list strip-or-accumulate))
(define-advice org-agenda-filter-by-tag (:filter-args (strip-or-accumulate &optional char exclude) inverse-filter-modification)
"Modify filter by default."
(setq strip-or-accumulate
(pcase strip-or-accumulate
('(16) nil)
('(nil) '(16))
(other other)))
(list strip-or-accumulate char exclude)))Focused daily agenda
This agenda show the items for the current day and time.- all the items with deadline, according
org-deadline-warning-days, unless the item is scheduled. If the item is scheduled, it is shown from the scheduled day.(defun org-agenda-skip-deadlines-before-schedule () "Skip tasks, with deadline and scheduled in future and tasks without deadline." (require 'org-agenda) (save-restriction (let* ((tmp-deadline-time (cl-letf (((symbol-function 'org-back-to-heading) (lambda (&rest _) t))) ; we should be at heading already and it consumes too much times otherwise (org-get-deadline-time (point)))) (tmp-scheduled-time (org-get-scheduled-time (point))) (tmp-cur-deadline (time-to-days tmp-deadline-time)) (tmp-cur-schedule (time-to-days tmp-scheduled-time)) (tmp-cur-day (time-to-days (apply #'encode-time (append '(0 0 0) (list (nth 1 org-agenda-current-date)) (list (nth 0 org-agenda-current-date)) (list (nth 2 org-agenda-current-date))))))) (when (or (not tmp-deadline-time) (and tmp-scheduled-time tmp-deadline-time (> tmp-cur-schedule tmp-cur-day) ;; Catch tasks scheduled after deadline (>= tmp-cur-deadline tmp-cur-schedule) ;;(> tmp-cur-deadline tmp-cur-day) )) (re-search-forward (org-get-limited-outline-regexp) nil 'noerror) (point)))))
- all [#A] priority items, with matching
:SHOWDATES:and:SHOWFROMTIME:, unless they are scheduled in the future(defun org-agenda-skip-nonurgent () (save-excursion (let* ((cur-priority (org-entry-get (point) "PRIORITY")) (tmp-scheduled-time (org-get-scheduled-time (point))) (tmp-cur-schedule (time-to-days tmp-scheduled-time)) (tmp-cur-day (time-to-days (apply #'encode-time (append '(0 0 0) (list (nth 1 org-agenda-current-date)) (list (nth 0 org-agenda-current-date)) (list (nth 2 org-agenda-current-date))))))) (unless (and (string-equal cur-priority "A") (or (not tmp-scheduled-time) (<= tmp-cur-schedule tmp-cur-day))) (unless (re-search-forward "^\\*.+\\[#A\\]" nil 'noerror) (re-search-forward org-outline-regexp nil 'noerror)) (point))))) (defun org-agenda-skip-nonurgent-fast () (save-excursion (let ((element (org-element-at-point))) (unless (or (eq (car element) 'inlinetask) (eq (car element) 'headline)) (org-back-to-heading) (setq element (org-element-at-point))) (let* ((cur-priority (string (or (org-element-property :priority element) org-default-priority))) (tmp-scheduled-time-element (org-element-property :raw-value (org-element-property :scheduled element))) (tmp-scheduled-time (and tmp-scheduled-time-element (org-parse-time-string tmp-scheduled-time-element))) (tmp-cur-schedule (time-to-days tmp-scheduled-time)) (tmp-cur-day (time-to-days (apply #'encode-time (append '(0 0 0) (list (nth 1 org-agenda-current-date)) (list (nth 0 org-agenda-current-date)) (list (nth 2 org-agenda-current-date))))))) (unless (and (string-equal cur-priority "A") (or (not tmp-scheduled-time) (<= tmp-cur-schedule tmp-cur-day))) (unless (re-search-forward "^\\*.+\\[#A\\]" nil 'noerror) (re-search-forward (org-get-limited-outline-regexp) nil 'noerror)) (point))))))
org-agenda-skip-nonurgent-fast
- State “NEXT” from “TODO” [2019-05-05 Sun 18:42]
- none of [#C] priority items
(defun org-agenda-skip-lowpriority ()
(save-restriction
(widen)
(let* (
(next-headline (save-excursion (or (outline-next-heading) (point-max))))
(cur-priority (org-entry-get (point) "PRIORITY")))
(if (string-equal cur-priority "C")
next-headline
nil))))- all the items scheduled for today and matching
:SHOWFROMTIME:(defun org-agenda-skip-not-today () "Skip items which are not scheduled today or scheduled earlier today." (save-restriction (widen) (let* ((next-headline (save-excursion (or (outline-next-heading) (point-max)))) (scheduleddate (subseq (decode-time (org-get-scheduled-time (point))) 3 6)) (currentdate (list (nth 1 org-agenda-current-date) (nth 0 org-agenda-current-date) (nth 2 org-agenda-current-date))) (scheduledhourend (org-element-property :hour-end (org-element-property :scheduled (org-element-at-point)))) (currenthour (string-to-number (format-time-string "%H")))) (if (and (equal scheduleddate currentdate) (or (not scheduledhourend) (<= currenthour scheduledhourend))) nil next-headline))))
- all items scheduled in the past or today with DOING todo keyword, respecting
:SHOWFROMTIME:and:SHOWDATES: - items from diary/with timestamps (shown by default in org)
- habits
(setq org-agenda-skip-deadline-prewarning-if-scheduled t)
(setq org-agenda-skip-scheduled-if-done t)
(setq org-agenda-skip-timestamp-if-done t)(defun yant/org-agenda-skip-nofocus ()
"Filter tasks for focus agenda."
(yant/org-agenda-skip-org-ql
'(and (not (done))
(not (tags "CANCELLED"))
(or (not (tags "WAITING" "HOLD"))
(not (todo "TICKLER")))
(or
(and (ts-active :to today)
(or (habit)
(priority "A")
(and (ts-active :on today)
(not (priority "C"))))
(not (org-agenda-skip-noshowdates))
(not (tags "HOLD" "SOMEDAY"))
(or (priority "A")
(not (tags "NODEADLINE"))))
(and (deadline)
(not (scheduled :from +1))))
(not (org-agenda-skip-before-SHOWFROMTIME-property))
(not (org-agenda-skip-before-SHOWFROMDATE-property))))
;; (and
;; (or
;; (zin/org-agenda-skip-tag "HOLD")
;; (zin/org-agenda-skip-tag "SOMEDAY")
;; (and
;; (org-agenda-skip-nonurgent) ; show urgent items
;; (bh/skip-nohabits) ; and habits
;; )
;; ;; if day and time are appropriate
;; (org-agenda-skip-before-SHOWFROMTIME-property)
;; (org-agenda-skip-before-SHOWFROMDATE-property)
;; (org-agenda-skip-noshowdates))
;; (or
;; (zin/org-agenda-skip-tag "HOLD")
;; (zin/org-agenda-skip-tag "SOMEDAY")
;; (org-agenda-skip-not-today) ; and items, scheduled for today
;; (org-agenda-skip-before-SHOWFROMTIME-property) ; if time is appropriate (day is, since it is scheduled)
;; (org-agenda-skip-before-SHOWFROMDATE-property)
;; (org-agenda-skip-lowpriority) ;; and the priorty is not [#C]
;; )
;; (or (org-agenda-skip-deadlines-before-schedule) ; always show deadlines, unless scheduled in future
;; (org-agenda-skip-before-SHOWFROMTIME-property)
;; (org-agenda-skip-before-SHOWFROMDATE-property)))
)
Normal daily agenda
This is a standard org mode agenda showing deadlines, schedules, diary items and items with timestamps.(setq org-agenda-skip-scheduled-if-done t)
(setq org-agenda-skip-deadline-if-done t)
(setq org-agenda-include-inactive-timestamps nil)SOMEDAY Automatically switching agenda views when current agenda is empty
[2021-07-18 Sun] This is too slow for now. May reconsider when I manage to speed up agenda further.
My usual daily workflow starts from Focused daily agenda -> Normal daily agenda -> List of NEXT tasks. I move from one agenda to another as previous agenda empties. Let’s to it automatically.
(defvar yant/agenda-sequence '("d" "s" "n"))
(defun org-agenda-empty-p ()
"Return non-nil when current agenda buffer is empty."
(when (eq major-mode 'org-agenda-mode))
(let ((empty t))
(catch :found
(save-excursion
(save-restriction
(goto-char (point-min))
(while (< (point) (point-max))
(when (get-text-property (line-beginning-position) 'org-hd-marker)
(setq empty nil)
(throw :found t))
(ignore-errors (next-line))))))
empty))
(defun yant/org-agenda (arg)
"Daily agenda moving from focused to normal to next tasks."
(interactive "P")
(catch :exit
(dolist (type yant/agenda-sequence)
(funcall-interactively #'org-agenda arg type)
(when (and (org-agenda-empty-p)
org-agenda-sticky)
(org-agenda-Quit)
(funcall-interactively #'org-agenda arg type))
(unless (org-agenda-empty-p)
(throw :exit t)))))GTD self-check
- Full daily agenda without hold tasks
INBOXitems to refile to other places- scheduled
- with deadline
- not scheduled
- Next tasks which are not yet scheduled
- Done tasks to archive, unless have
:NOARCHIVE:tag. - Project list
- Waiting and hold tasks, which are not scheduled
- Other tasks which are not part of project or has
SKIPtag. Useful to catch wrong refiles and look for the new things to do. Blocked tasks are not shown here.
Captured items, which should be refiled
These items should have:INBOX: tag. Also, if both project and sub-project have :INBOX: tag, only topmost project should be refiled.
(defun yant/org-agenda-inbox-items ()
"Only show items with INBOX tag, which parents does not have this tag."
(save-excursion
(save-restriction
(widen)
(let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point)))
(next-headline (save-excursion (or (outline-next-heading) (point-max))))
result)
(if (not (member "INBOX" (org-get-tags-at)))
next-headline
(while (and (not result)
(org-up-heading-safe))
(when (member "INBOX" (org-get-tags-at))
(setq result next-headline)))
result)))))Since my org files are really very large, it usually takes a lot of time to rebuild agenda. In the case of refiling, the org-agenda-refile rebuilds the agenda after each refiling, which really slows down my refile workflow. Hence, I disable redoing the current agenda after running org-agenda-refile or org-agenda-bulk-action.
(defun yant/org-agenda-refile (&optional arg)
(interactive "P")
(funcall-interactively #'org-agenda-refile arg nil 'no-update))
(bind-key "C-c C-w" #'yant/org-agenda-refile org-agenda-mode-map)
(bind-key "C-c w" #'yant/org-agenda-refile org-agenda-mode-map)
(define-advice org-agenda-bulk-action (:around (oldfun &optional arg) disable-org-agenda-redo)
"Disable `org-agenda-redo' for all the bulk actions."
(cl-letf (((symbol-function 'org-agenda-redo) #'ignore))
(funcall oldfun)))Ever standing project list
[#A] org-timeline
The package idea is cool, but I would prefer vertical view. Need to write my own package later.
(use-package org-timeline
:if init-flag
:disabled
:straight t
:config
(add-hook 'org-agenda-finalize-hook 'org-timeline-insert-timeline :append))CalFW
Agenda is excellent for short term planning, however it is not very useful if I need to schedule something, say, for 3 month later. I prefer something like normal calendar with short summary of the scheduled tasks to plan the task being scheduled.
(use-package calfw
:if init-flag
:straight t
:config
(use-package calfw-org
:straight t
:after org
:config
(setq calendar-week-start-day 1)
(defun cfw:open-calendar (arg)
(interactive "P")
(let ((cp
(cfw:create-calendar-component-buffer
:view (if arg 'month 'week)
:contents-sources
(list
(cfw:org-create-source)))))
(switch-to-buffer (cfw:cp-get-buffer cp))))
(use-package boon
:config
(defun yant/cfw:open-calendar (arg)
"Run `cfw:open-calendar' with skip function hiding non-important tasks."
(interactive "P")
(let ((org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (and (ts-active)
(not (habit))
(not (tags "SKIP"))
(not (todo "TICKLER")))))))
(cfw:open-calendar arg)))
(bind-key "A" #'yant/cfw:open-calendar 'boon-goto-map))
(custom-set-faces
'(cfw:face-title ((t (:foreground "#f0dfaf" :weight bold :height 2.0 :inherit variable-pitch))))
'(cfw:face-header ((t (:foreground "#d0bf8f" :weight bold))))
'(cfw:face-sunday ((t :foreground "#cc9393" :background "grey10" :weight bold)))
'(cfw:face-saturday ((t :foreground "#8cd0d3" :background "grey10" :weight bold)))
'(cfw:face-holiday ((t :background "grey10" :foreground "#8c5353" :weight bold)))
'(cfw:face-grid ((t :foreground "DarkGrey")))
'(cfw:face-default-content ((t :foreground "#bfebbf" :height 0.7)))
'(cfw:face-periods ((t :foreground "cyan")))
'(cfw:face-day-title ((t :background "grey10")))
'(cfw:face-default-day ((t :weight bold :inherit cfw:face-day-title)))
'(cfw:face-annotation ((t :foreground "RosyBrown" :inherit cfw:face-day-title)))
'(cfw:face-disable ((t :foreground "DarkGray" :inherit cfw:face-day-title)))
'(cfw:face-today-title ((t :background "#7f9f7f" :weight bold)))
'(cfw:face-today ((t :background: "grey10" :weight bold)))
'(cfw:face-select ((t :background "#2f2f2f")))
'(cfw:face-toolbar ((t :foreground "Steelblue4" :background "Steelblue4")))
'(cfw:face-toolbar-button-off ((t :foreground "Gray10" :weight bold)))
'(cfw:face-toolbar-button-on ((t :foreground "Gray50" :weight bold))))
;; Unicode characters
(setq cfw:fchar-junction ?╋
cfw:fchar-vertical-line ?┃
cfw:fchar-horizontal-line ?━
cfw:fchar-left-junction ?┣
cfw:fchar-right-junction ?┫
cfw:fchar-top-junction ?┯
cfw:fchar-top-left-corner ?┏
cfw:fchar-top-right-corner ?┓)))Handling different time zones in time stamps
It is sometimes very annoying when org mode assumes that all the time stamps are in local time zone. Foe example, I have a round flight, and want to schedule it to not forget coming back ;). But the timing will be shifted for return flight if I go to different time zone. Hence I would like to have some way to fix the time zone of time stamp. I do it by defining time stamp like<YYYY-MM-DD HH:MM #TIMEZONE#>, where
TIMEZONE is time zone as in /usr/share/zoneinfo.
It is implemented by wrapping the hook to correct the time around
org-parse-time-string, which seems to be enough to correct org mode
behavior. The stamps without time are not parsed (how?).NEXT [#A] Make sure it works
- agenda does not use
org-parse-time-stringto find displayed string in timeline, even though task will be shown/not shown respecting time zone
;; force matching of time zone formatted time stamps
(setf org-scheduled-time-hour-regexp (concat "\\<" org-scheduled-string
" *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\(?:#[^#]+#* \\)?\\)>"))
(setf org-deadline-time-hour-regexp (concat "\\<" org-deadline-string
" *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\(?:#[^#]+#* \\)?\\)>"))
(define-advice org-parse-time-string (:around (oldfun s &optional NODEFAULT) org-parse-timezone)
"Convert time stamp to local time if time zone information is present.
Do not handle time stamps without time.
Time zone is located like '<YYYY-MM-DD HH:MM #TIMEZONE#>'.
TIMEZONE is according to system timezone format (as accepted by `current-time-zone')."
(let ((return-val (funcall oldfun s NODEFAULT)))
(if (and (string-match org-ts-regexp0 s)
(not NODEFAULT))
(if (string-match "#\\([^#]+\\)#" s)
(let ((result (decode-time (- (float-time (apply 'encode-time
return-val))
(- (car (current-time-zone nil (match-string 1 s)))
(car (current-time-zone)))))))
(setf (car result) 0)
(append (butlast result 3) '(nil nil nil)))
return-val)
return-val)))
(define-advice org-parse-time-string (:around (oldfun s &optional NODEFAULT) org-convert-atpm-to-24)
"Honor am/pm format by `org-parse-time-string'."
(let* ((match (string-match " *#[^#]+#" s)) ; avoid infinite recursion loop with time zone parsing in `org-get-time-of-day'
(timeofday (org-get-time-of-day (if match
(replace-match "" nil nil s)
s)
'string)))
(if (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
(string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
(funcall oldfun (replace-match timeofday nil nil s) NODEFAULT)
(funcall oldfun s NODEFAULT))))
(define-advice org-parse-time-string (:around (oldfun s &optional NODEFAULT) org-timestamp-parse-no-date)
"Make `org-parse-time-string' work with time stamps without date (just consider today)."
(when (and (not (string-match "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" s))
(or (string-match "\\<\\(\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *\\)" s)
(string-match "\\<\\(\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *\\)" s)))
(setf s (replace-match (concat (format-time-string "%Y-%m-%d %a " (org-matcher-time "<today>"))
"\\&")
nil nil s)))
(funcall oldfun s NODEFAULT))
(define-advice org-get-time-of-day (:around (oldfun s &optional string mod24) org-timestamp-convert-to-local-timezone)
"Convert time stamp with #TIMEZONE# to time stamp in local time zone."
(if (string-match "#[^#]+#" s)
(funcall oldfun (format-time-string "%Y-%m-%d %k:%M"
(apply #'encode-time
(org-parse-time-string s)))
string mod24)
(funcall oldfun s string mod24)))Unfortunately, org-agenda-get-scheduled has hard coded setting to
calculate time of the entry and not respecting org-parse-timestring or
org-get-time-of-day. Hence, I need to rewrite it just for sake of
changing (concat (substring s (match-beginning 1)) " ")) into (concat
(org-get-time-of-day s t) " ")).
(defun org-agenda-get-scheduled (&optional deadlines with-hour)
"Return the scheduled information for agenda display.
Optional argument DEADLINES is a list of deadline items to be
displayed in agenda view. When WITH-HOUR is non-nil, only return
scheduled items with an hour specification like [h]h:mm."
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'done-face 'org-agenda-done
'mouse-face 'highlight
'help-echo
(format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
(today (org-today))
(todayp (org-agenda-today-p date)) ; DATE bound by calendar.
(current (calendar-absolute-from-gregorian date))
(deadline-pos
(mapcar (lambda (d)
(let ((m (get-text-property 0 'org-hd-marker d)))
(and m (marker-position m))))
deadlines))
scheduled-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
(unless (save-match-data (org-at-planning-p)) (throw :skip nil))
(org-agenda-skip)
(let* ((s (match-string 1))
(pos (1- (match-beginning 1)))
(todo-state (save-match-data (org-get-todo-state)))
(donep (member todo-state org-done-keywords))
(show-all (or (eq org-agenda-repeating-timestamp-show-all t)
(member todo-state
org-agenda-repeating-timestamp-show-all)))
;; SCHEDULE is the bare scheduled date, i.e., without
;; any repeater if non-nil, or last repeat if SHOW-ALL
;; is nil. REPEAT is the closest repeat after CURRENT,
;; if all repeated time stamps are to be shown, or
;; after TODAY otherwise. REPEAT only applies to
;; future dates.
(schedule (if show-all (org-agenda--timestamp-to-absolute s)
(org-agenda--timestamp-to-absolute
s today 'past (current-buffer) pos)))
(repeat (cond ((< current today) schedule)
(show-all
(org-agenda--timestamp-to-absolute
s current 'future (current-buffer) pos))
(t
(org-agenda--timestamp-to-absolute
s today 'future (current-buffer) pos))))
(diff (- current schedule))
(warntime (get-text-property (point) 'org-appt-warntime))
(pastschedp (< schedule today))
(habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
(suppress-delay
(let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
(org-entry-get nil "DEADLINE"))))
(cond
((not deadline) nil)
;; The current item has a deadline date, so
;; evaluate its delay time.
((integerp org-agenda-skip-scheduled-delay-if-deadline)
;; Use global delay time.
(- org-agenda-skip-scheduled-delay-if-deadline))
((eq org-agenda-skip-scheduled-delay-if-deadline
'post-deadline)
;; Set delay to no later than DEADLINE.
(min (- schedule
(org-agenda--timestamp-to-absolute deadline))
org-scheduled-delay-days))
(t 0))))
(ddays
(cond
;; Nullify delay when a repeater triggered already
;; and the delay is of the form --Xd.
((and (string-match-p "--[0-9]+[hdwmy]" s)
(> current schedule))
0)
(suppress-delay
(let ((org-scheduled-delay-days suppress-delay))
(org-get-wdays s t t)))
(t (org-get-wdays s t)))))
;; Display scheduled items at base date (SCHEDULE), today if
;; scheduled before the current date, and at any repeat past
;; today. However, skip delayed items and items that have
;; been displayed for more than `org-scheduled-past-days'.
(unless (and todayp
habitp
(bound-and-true-p org-habit-show-all-today))
(when (or (and (> ddays 0) (< diff ddays))
(> diff org-scheduled-past-days)
(> schedule current)
(and (< schedule current)
(not todayp)
(/= repeat current)))
(throw :skip nil)))
;; Possibly skip done tasks.
(when (and donep
(or org-agenda-skip-scheduled-if-done
(/= schedule current)))
(throw :skip nil))
;; Skip entry if it already appears as a deadline, per
;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
;; doesn't apply to habits.
(when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
((guard
(or (not (memq (line-beginning-position 0) deadline-pos))
habitp))
nil)
(`repeated-after-deadline
(>= repeat (time-to-days (org-get-deadline-time (point)))))
(`not-today pastschedp)
(`t t)
(_ nil))
(throw :skip nil))
;; Skip habits if `org-habit-show-habits' is nil, or if we
;; only show them for today. Also skip done habits.
(when (and habitp
(or donep
(not (bound-and-true-p org-habit-show-habits))
(and (not todayp)
(bound-and-true-p
org-habit-show-habits-only-for-today))))
(throw :skip nil))
(save-excursion
(re-search-backward "^\\*+[ \t]+" nil t)
(goto-char (match-end 0))
(let* ((category (org-get-category))
(inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
(memq 'agenda org-agenda-show-inherited-tags))
(and (eq org-agenda-show-inherited-tags t)
(or (eq org-agenda-use-tag-inheritance t)
(memq 'agenda
org-agenda-use-tag-inheritance)))))
(tags (org-get-tags-at nil (not inherited-tags)))
(level
(make-string (org-reduced-level (org-outline-level)) ?\s))
(head (buffer-substring (point) (line-end-position)))
(time
(cond
;; No time of day designation if it is only
;; a reminder.
((and (/= current schedule) (/= current repeat)) nil)
((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
(concat (org-get-time-of-day s t) " "))
(t 'time)))
(item
(org-agenda-format-item
(pcase-let ((`(,first ,next) org-agenda-scheduled-leaders))
(cond
;; If CURRENT is in the future, don't use past
;; scheduled prefix.
((> current today) first)
;; SHOW-ALL focuses on future repeats. If one
;; such repeat happens today, ignore late
;; schedule reminder. However, still report
;; such reminders when repeat happens later.
((and (not show-all) (= repeat today)) first)
;; Initial report.
((= schedule current) first)
;; Subsequent reminders. Count from base
;; schedule.
(t (format next (1+ diff)))))
head level category tags time nil habitp))
(face (cond ((and (not habitp) pastschedp)
'org-scheduled-previously)
(todayp 'org-scheduled-today)
(t 'org-scheduled)))
(habitp (and habitp (org-habit-parse-todo))))
(org-add-props item props
'undone-face face
'face (if donep 'org-agenda-done face)
'org-marker (org-agenda-new-marker pos)
'org-hd-marker (org-agenda-new-marker (line-beginning-position))
'type (if pastschedp "past-scheduled" "scheduled")
'date (if pastschedp schedule date)
'ts-date schedule
'warntime warntime
'level level
'priority (if habitp (org-habit-get-priority habitp)
(+ 99 diff (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
(push item scheduled-items))))))
(nreverse scheduled-items)))Agenda bulk actions
I routinely use the agenda feature to mark multiple tasks and perform an action on all of them.
For example, my typical archiving workflow involves going through archive candidates in my Full agenda for GTD self-check (see Archiving) using agenda follow mode and I archive some of the tasks and mark some with :NOARCHIVE: tag (see General org mode tags).
By default, marking a task does not result in updated agenda follow buffer, so I fix it below.
[2020-05-14 Thu] Disabling since I am using categories now, which are verbose enough most of time.
;; (define-advice org-agenda-bulk-mark (:after (&rest args) update-follow-mode)
;; "Update follow mode buffer after marking."
;; (org-agenda-do-context-action))
;; (advice-add 'org-agenda-bulk-unmark :after #'org-agenda-bulk-mark@update-follow-mode)Further, I use tags-todo search to find all unscheduled tasks, which are also not marked as NEXT, and decide what to do with them.
Typically, I simply scatter them over a week or other period of time.
However, tags-todo search cannot be used for scattering via explicit check in org-agenda-bulk-action.
Disabling it (at least, until I find when that check is actually useful).
(define-advice org-agenda-bulk-action (:around (oldfun &optional arg) disable-org-agenda-check-type)
"Always return 't when checking agenda type."
(cl-letf (((symbol-function 'org-agenda-check-type) (lambda (&rest args) t)))
(apply oldfun arg)))Agenda search
It is possible to search from agenda dispatcher not only in the org files, but also in archives (from Dig Into Org Mode by Aaron Bieber)
(setq org-agenda-text-search-extra-files '(agenda-archives))Show entry contents in agenda
Showing part of entry content can be important to immediately see some important information related to the task in agenda.
For example, this can be achieved using org-agenda-entry-text-mode.
However, this mode appears to clutter the agenda too much, as for me.
An alternative can be org-quick-peek package, which creates a temporary overlay showing the first lines of the task at point.
For a while, I tried to bind revealing the task contents in agenda on a key press (TAB). However, I found myself missing earlier notes I sometimes add to my bookmark tasks. When the bookmark is a long article, I may read it half way and save the location where I stopped in the task body. Later, I just forget that I started reading and do not even check the task body… The solution is to show the task contents of every task at point in agenda. Also, hide the contents once task is clocked out.
auto-show the contents. make it minor-modeEND(setq org-agenda-start-with-entry-text-mode nil)
(use-package quick-peek
:defer t
:straight t)
(use-package org-quick-peek
:if init-flag
:after org
:straight (org-quick-peek :type git :host github :repo "alphapapa/org-quick-peek" :local-repo "~/Git/org-quick-peek"
:fork (:host github :repo "yantar92/org-quick-peek"))
:init (use-package quick-peek :demand t)
:custom
(org-quick-peek-show-lines 20)
(org-quick-peek-show-drawers nil)
(org-quick-peek-show-planning nil)
(org-quick-peek-filter-functions (list (apply-partially #'s-replace-regexp "\n" "\n\n")
(apply-partially #'s-word-wrap 80)
#'s-trim
(apply-partially #'s-replace-regexp "\n+" "\n")))
:config
(bind-key "<tab>" #'org-quick-peek-agenda-current-item 'org-agenda-mode-map)
(define-advice org-agenda-clock-in (:after (&rest args) quick-peek-maybe)
"Show contents of the org-entry at point when there is any."
(org-agenda-redo@org-quick-peek--hide-all)
(org-quick-peek--agenda-show :quiet t))
(defun yant/org-agenda-hide-org-quick-peek-overlays-from-clocking ()
"Hide all org-quick-peek overlays in `org-agenda-buffer'."
(dolist (agenda-buffer (mapcar #'get-buffer
(seq-filter (apply-partially #'s-contains-p "*Org Agenda")
(mapcar #'buffer-name (buffer-list)))))
(when (buffer-live-p agenda-buffer)
(with-current-buffer agenda-buffer
(mapc (lambda (o)
(when (eq (overlay-get o 'type) 'org-agenda-clocking)
(quick-peek-hide)))
(overlays-in (point-min) (point-max)))))))
(add-hook 'org-clock-out-hook #'yant/org-agenda-hide-org-quick-peek-overlays-from-clocking))[2020-09-08 Tue] Fixing org-quick-peek creating invisible overlay when agenda filter is in place and the next item is hidden by the filter Bug report: [[id:75b22f226a98806ce13c1834e115450e0aa3c01a][yantar92 [Github] issue#9 The overlay is not always visible when org-agenda-filter is in place]]
(use-package org-quick-peek
:if init-flag
:after org
:config
(defun quick-peek-overlay-ensure-at (pos)
"Find or create a quick-peek overlay for the line at POS.
Typical code should not need this method; use `quick-peek-show'
instead."
(or (quick-peek-overlay-at pos)
(let* ((ov (save-excursion
(goto-char pos)
(make-overlay (point-at-bol) (1+ (point-at-eol))))))
(overlay-put ov 'quick-peek t)
;; Add impossible invisible property
(overlay-put ov 'invisible 'nope)
(push ov quick-peek--overlays)
ov))))Trying org-ql
I do not really use SHOWDATES? think about itEND
(use-package org
:defer t
:config
(add-to-list 'org-default-properties "SHOWDATES"))
(defun yant/diary-sexp-match-showdate? (entry) ;; the ENTRY name is important, since it is used internally by calendar
"Does current time match SHOWDATE?."
(or (not entry) ;; no condition: match
(let ((date (diary-make-date (nth 4 (decode-time)) (nth 3 (decode-time)) (nth 5 (decode-time)))))
(pcase (eval (car (read-from-string entry)))
((and (pred listp) res)
(when (cdr res) t))
(res (when res t))))))
(defun yant/now-after-showfromtime? (showfromtime)
"Is time of the day after SHOWFROMTIME? Take into account `org-extend-today-until'."
(let* ((now (ts-now))
(beginningofday (ts-parse (format "%s %s:00"
(ts-format "%Y-%m-%d" now)
(or org-extend-today-until 0))))
(stillyesterday? (ts<= now beginningofday))
(showfromtime (ts-parse (s-concat (ts-format "%Y-%m-%d " now)
showfromtime))))
(or stillyesterday? (ts>= now showfromtime))))
(use-package org-ql
:straight (org-ql :type git :host github :repo "alphapapa/org-ql" :local-repo "~/Git/org-ql"
:fork (:host github :repo "yantar92/org-ql"))
:after org
:config
(use-package org-ql-search :demand t)
(setq org-ql-plain-string-predicate 'keyword)
(org-ql-defpred (keyword k) (&rest strings)
"Match a keyword in outline-path or inside body/heading with #.
Negate match when start with ^."
:normalizers
((`(,predicate-names . ,strings)
`(keyword ,@strings)))
:body
(or
(catch :fail
(dolist (string strings)
(unless
(pcase string
((pred (string= "A")) (tags-local "AREA"))
((pred (string= "p")) (tags-local "project"))
((pred (string= "a")) (tags-local "article"))
((pred (string= "b")) (tags-local "book"))
((pred (string= "n")) (tags-local "note"))
((pred (string= "m")) (tags-local "BOOKMARK"))
((pred (string= "f")) (tags-local "FLAGGED"))
((pred (string= "S")) (todo "SOMEDAY"))
((pred (string= "N")) (todo "NEXT"))
((pred (string= "D")) (todo "DONE"))
((pred (string= "T")) (todo "TODO"))
((pred (string= "O")) (todo "DOING"))
((pred (string= "F")) (todo "FAILED"))
((pred (string= "W")) (todo "WAITING"))
((pred (string= "H")) (todo "HOLD"))
((pred (string= "C")) (todo "CANCELLED"))
((pred (string= "L")) (todo "TICKLER"))
((pred (string= "E")) (todo "REVIEW"))
((and (rx string-start (let str (1+ any)) ":" string-end)
(guard str))
(tags str))
((and (rx string-start (let str (1+ any)) "!" string-end)
(guard str))
(tags-local str))
((and (rx string-start (let str (1+ any)) "/" string-end)
(guard str))
(path str))
((and (rx string-start (let str (1+ any)) ";" string-end)
(guard str))
(heading str))
((and (rx string-start (let str (1+ any)) "=" string-end)
(guard str))
(or (regexp str)
(outline-path str)))
((and (rx string-start (let str (1+ any)) "#" string-end)
(guard str))
(regexp (rx-to-string `(or (seq "#" (1+ (not " ")) "_" ,str (or eow "_"))
(seq "#" ,str (or eow "_"))))))
(str
(or (path str)
(regexp (rx-to-string `(or (seq "#" (1+ (not " ")) (any ?- "_/") ,str)
(seq "#" ,str))))
(let ((case-fold-search t)) (outline-path (rx-to-string `(seq bow ,str))))
(let ((case-fold-search t)) (regexp (rx-to-string `(seq bol ":" (or "AUTHOR" "JOURNAL" "YEAR") ": " (0+ any) ,str))))
(tags-regexp str)
(tags str)
(ancestors (org-ql--query-predicate
(org-ql--normalize-query `(or (path ,str)
(regexp (rx-to-string '(or (seq "#" (1+ (not " ")) (any ?- "_/") ,str)
(seq "#" ,str))))
(let ((case-fold-search t)) (regexp (rx-to-string '(seq bol ":" (or "AUTHOR" "JOURNAL" "YEAR") ": " (0+ any) ,str)))))))))))
(throw :fail nil)))
t)
(when (and (outline-next-heading)
(let ((case-fold-search t))
(re-search-forward
(regexp-opt
(cl-loop for string in strings
collect
(pcase string
((pred (string= "A")) "AREA")
((pred (string= "p")) "project")
((pred (string= "a")) "article")
((pred (string= "b")) "book")
((pred (string= "n")) "note")
((pred (string= "m")) "BOOKMARK")
((pred (string= "f")) "FLAGGED")
((pred (string= "S")) "SOMEDAY")
((pred (string= "N")) "NEXT")
((pred (string= "D")) "DONE")
((pred (string= "T")) "TODO")
((pred (string= "O")) "DOING")
((pred (string= "F")) "FAILED")
((pred (string= "W")) "WAITING")
((pred (string= "H")) "HOLD")
((pred (string= "C")) "CANCELLED")
((pred (string= "L")) "TICKLER")
((pred (string= "E")) "REVIEW")
((and (rx string-start (let str (1+ any)) ":" string-end)
(guard str))
str)
((and (rx string-start (let str (1+ any)) "!" string-end)
(guard str))
str)
((and (rx string-start (let str (1+ any)) "/" string-end)
(guard str))
str)
((and (rx string-start (let str (1+ any)) ";" string-end)
(guard str))
str)
((and (rx string-start (let str (1+ any)) "=" string-end)
(guard str))
str)
((and (rx string-start (let str (1+ any)) "#" string-end)
(guard str))
(rx-to-string `(or (seq "#" (1+ (not " ")) "_" ,str (or eow "_"))
(seq "#" ,str (or eow "_")))))
(string
string))))
nil 'move)))
;; Move to next likely match.
(org-back-to-heading t)
(backward-char))))
(defun yant/org-ql-focused-agenda-block (&rest args)
"Return expression, suitable for `org-agenda-custom-commands', which matches focused agenda view."
(org-ql-block
'(and (todo)
(not (priority "C"))
(or (and (deadline auto) ;; deadline check first because deadlines are far more scarse in comparison with scheduled
(not (scheduled :from +1)))
(and (priority "A")
(scheduled :to 0) ;; these two are easy checks, do them before heavy property matches
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(yant/now-after-showfromtime? (org-entry-get (point) "SHOWFROMTIME" 'inherit)) ;; I have more of this in cmp with SHOWDATES
(yant/diary-sexp-match-showdate? (org-entry-get (point) "SHOWDATES" 'inherit))
)
(and (scheduled :on 0)
(yant/now-after-showfromtime? (org-entry-get (point) "SHOWFROMTIME" 'inherit)))
(ts-active :on 0) ;; diary
))))
(eval
'(defun org-ql-skip-function (query)
"Return a function for `org-agenda-skip-function' for QUERY.
Compared to using QUERY in `org-ql', this effectively turns QUERY
into (not QUERY)."
(let* ((predicate (org-ql--query-predicate (org-ql--pre-process-query query))))
(lambda ()
;; This duplicates the functionality of `org-ql--select'.
(let (orig-fns)
(--each org-ql-predicates
;; Save original function mappings.
(let ((name (plist-get it :name)))
(push (list :name name :fn (symbol-function name)) orig-fns)))
(unwind-protect
(progn
(--each org-ql-predicates
;; Set predicate functions.
(fset (plist-get it :name) (plist-get it :fn)))
;; Run query.
;; FIXME: "If this function returns nil, the current match should not be skipped.
;; Otherwise, the function must return a position from where the search
;; should be continued."
(funcall predicate))
(--each orig-fns
;; Restore original function mappings.
(fset (plist-get it :name) (plist-get it :fn))))))))
'lexical)
(defun yant/org-ql-focused-agenda-query ()
"Return org-ql skip function that matches focused agenda view."
(org-ql-skip-function
'(and (todo)
(not (priority "C"))
(or (and (deadline auto) ;; deadline check first because deadlines are far more scarse in comparison with scheduled
(not (scheduled :from +1)))
(and (priority "A")
(scheduled :to 0) ;; these two are easy checks, do them before heavy property matches
(or (not (property "SHOWFROMDATE")) ;; non-inheriting property search can be cached efficiently. Hence do it first
(ts>= (ts-now) (ts-parse-org (property "SHOWFROMDATE"))))
(yant/now-after-showfromtime? (org-entry-get (point) "SHOWFROMTIME" 'inherit)) ;; I have more of this in cmp with SHOWDATES
(yant/diary-sexp-match-showdate? (org-entry-get (point) "SHOWDATES" 'inherit))
)
(and (scheduled :on 0)
(yant/now-after-showfromtime? (org-entry-get (point) "SHOWFROMTIME" 'inherit)))
(ts-active :on 0) ;; diary
)
)))
(defun yant/org-ql-full-agenda-block (&rest args)
"Return expression, suitable for `org-agenda-custom-commands', which lists all the active scheduled todo items."
(org-ql-block
'(and (todo)
(scheduled :to 0)
(not (tags "HOLD")))))
;; how to do it? I do not want children to be listed if the parent is listed. But cannot give up tag inheritance
;; In normal agenda, it is achieved by `org-tags-match-list-sublevels'
(defun yant/org-ql-inbox-block (&rest args)
"Return expression, suitable for `org-agenda-custom-commands', which lists all the inbox items."
(org-ql-block
'(and (level 1)
(tags "INBOX"))))
;; changing the project definition. Either project tag or the sub-project with NEXT/DOING/REVIEW
(defmacro yant/org-ql-is-project-p ()
"org-ql query to match a project."
`(or (and (tag "project")
(todo))
(and (todo "NEXT" "DOING" "REVIEW")
(children (todo)))))
(defun yant/org-ql-stuck-projects-block (&rest args)
"Return expression, suitable for `org-agenda-custom-commands', which lists all the stuck projects."
(org-ql-block
'(and (not (tags "HOLD" "WAITING"))
(yant/org-ql-is-project-p)
(not (children (todo "NEXT" "DOING" "REVIEW"))))))
(defun yant/org-ql-waiting-and-hold-tasks-block (&rest args)
"Return expression, suitable for `org-agenda-custom-commands', which lists all the waiting and hold tasks."
(org-ql-block
'(todo "HOLD" "WAITING")))
;; (defun yant/org-ql-next-tasks-block (&rest args)
;; "Return expression, suitable for `org-agenda-custom-commands', which lists all the NEXT and REVIEW tasks in projects."
;; (org-ql-block
;; '(and (not (habit))
;; ()
;; )))
)use it |- (alphapapa/org-ql: An Org query language, and experimental code for a next-generation Org Agenda)
- Refiled on [2019-12-23 Mon 18:07]
helm-org-ql
(use-package helm-org-ql
:if init-flag
:after org-ql
:after helm-org
:init
(defun yant/helm-org-ql-set-preceding-task (marker)
"Make task at point follow other (selected) task.
The current task will be marked WAITING and cannot be marked DONE
until the other task is completed.
Its :SUMMARY: property will contain the information about the blocker
Completing the other (selected) task will automatically set the
current task to NEXT and schedule it the same day."
(let ((uuid (org-with-point-at marker (org-id-get-create)))
(cur-uuid (org-id-get-create)))
(unless uuid (user-error "Did not get a uuid"))
(org-todo "WAITING")
(org-set-property "BLOCKER" (format "ids(%s)" uuid))
(org-set-property "SUMMARY" (format "Blocked by %s" (org-with-point-at (org-id-find uuid 'marker) (org-get-heading t t t t))))
(org-set-tags (cl-adjoin "TRACK" (org-get-tags nil 'local)))
(org-with-point-at marker
(org-set-property "TRIGGER" (format "%s ids(\"%s\") todo!(NEXT) scheduled!(\".\") delete-property!(\"SUMMARY\")"
(or (org-entry-get nil "TRIGGER") "")
cur-uuid)))))
(defun yant/helm-org-ql-create-link (marker)
"Insert link to MARKER at point."
(insert (org-with-point-at marker
(if (and (org-entry-get (point) "AUTHOR")
(org-entry-get (point) "YEAR")
(org-entry-get (point) "JOURNAL"))
(let ((heading (org-get-heading t t t t)))
(format "[[id:%s][%s]]"
(org-id-get-create)
(--> heading
(replace-regexp-in-string ").+" "" it)
(replace-regexp-in-string "\\[" "" it)
(replace-regexp-in-string "\\]" "" it)
(replace-regexp-in-string "(" "" it))))
(org-store-link nil)))))
(defun yant/helm-org-ql-insert-url (marker)
"Insert URL from link at point."
(when-let ((link (or (org-entry-get marker "Source")
(org-entry-get marker "URL"))))
(save-match-data
(string-match "^\\(?:\\[\\[\\)?\\([^]]+\\)" link)
(insert (match-string 1 link)))))
(defun yant/helm-org-ql-open-url (marker)
"Open URL from link"
(org-with-point-at marker
(if (and (org-attach-dir) (org-attach-file-list (org-attach-dir)))
(org-attach-open)
(let ((link (or (org-entry-get marker "Source")
(org-entry-get marker "URL"))))
(if link (org-open-link-from-string link)
;; Offer standard selection
(org-open-at-point))))))
(defun yant/helm-org-ql-show-in-agenda (markers)
"Show agenda view with all the matches."
(let ((org-agenda-skip-function `(lambda ()
(org-back-to-heading t)
(let ((markerhere (point-marker))
(markers ',(helm-marked-candidates)))
(setq markers (-filter (lambda (marker) (eq (current-buffer) (marker-buffer marker))) markers))
(if (member (point-marker) markers)
nil
(while (and markers
(> markerhere (car markers)))
(setq markers (cdr markers)))
(if (car markers)
(goto-char (car markers))
(goto-char (point-max)))))))
(org-agenda-skip-location-context t)
(org-agenda-sticky nil))
(org-tags-view nil "!")))
(defun yant/helm-org-ql-show-marker (marker)
"Show heading at MARKER"
(interactive)
(when marker
(if helm-full-frame
(switch-to-buffer (marker-buffer marker))
(pop-to-buffer (marker-buffer marker)))
(widen)
(goto-char marker)
(org-show-set-visibility 'ancestors)
;; (org-fold-heading nil t)
(if (fboundp 'org-fold-show-children)
(org-fold-show-children)
(org-show-children))
(org-cycle-hide-drawers 'children)
;; (org-fold-show-children)
(recenter 2)))
(defvar yant/helm-org-ql--refile-history nil)
(defun yant/helm-org-ql-refile-to (&optional marker)
"Refile heading at point to selected heading at MARKER."
(require 'org-macs)
(when marker
(let* ((buffer (marker-buffer marker))
(filename (or (buffer-file-name buffer) (buffer-file-name (buffer-base-buffer buffer))))
;; get the heading we refile to so org doesn't
;; output 'Refile to "nil" in file ...'
(heading (org-with-point-at marker (org-get-heading :no-tags :no-todo :no-priority :no-comment)))
(rfloc (list heading filename nil marker)))
;; Probably best to check that everything returned a value
(when (and buffer filename rfloc)
(push marker yant/helm-org-ql--refile-history)
(setq yant/helm-org-ql--refile-history (delete-dups yant/helm-org-ql--refile-history))
(org-with-point-at-org-buffer
(when-let ((org-agenda-buffer-name (and (boundp 'agenda-buffer) agenda-buffer)))
(org-remove-subtree-entries-from-agenda))
(org-refile nil nil rfloc))))))
(defun yant/helm-org-ql-yank-selection ()
"Yank search exp matching selected heading's children."
(interactive)
;; (with-helm-buffer
;; (setq-local helm-org-ql-filter `(ancestor (property "ID" ,(org-with-point-at (helm-get-selection) (org-id-get-create))))))
(with-current-buffer (marker-buffer (helm-get-selection))
(widen)
(goto-char (helm-get-selection))
(org-narrow-to-subtree)
(narrow-to-region (or (outline-next-heading) (point-min)) (point-max))
(let ((beg (point-min))
(end (point-max)))
(with-helm-buffer
(helm-attrset
:cleanup
(if-let ((cleanfunc (helm-attr :cleanup)))
`(lambda ()
(funcall ,cleanfunc)
(with-current-buffer ,(marker-buffer (helm-get-selection)) (widen)))
`(lambda () (with-current-buffer ,(marker-buffer (helm-get-selection)) (widen)))))
(setq-local helm-org-ql-buffers-files (marker-buffer (helm-get-selection)))
(setq-local helm-org-ql-narrow t)
(helm-attrset 'name (helm-get-selection nil t))
(setq-local helm-org-ql-filter (or helm-org-ql-filter t)))))
(helm-set-pattern ""))
(defun yant/helm-org-ql-refile (arg)
"Helmified version of `org-refile' using `helm-org-ql'."
(interactive "P")
(catch 'exit
(setq yant/helm-org-ql--refile-history
(seq-filter
(lambda (el) (and (buffer-live-p (marker-buffer el))
(org-with-point-at el (org-at-heading-p))))
yant/helm-org-ql--refile-history))
(let ((helm-org-ql-actions (pcase arg
('(4) '(("Go to heading" . yant/helm-org-ql-show-marker)
("Refile heading at point to selected heading" . yant/helm-org-ql-refile-to)))
('(16)
(yant/helm-org-ql-show-marker (car yant/helm-org-ql--refile-history))
(throw 'exit t))
(2
(when (org-clock-is-active)
(yant/helm-org-ql-refile-to org-clock-marker)
(throw 'exit t)))
(`bulk-agenda-command
;; Return marker to serve as argument for `org-agenda-bulk-custom-functions'.
;; The return argument will be applied using
;; (apply #'yant/helm-org-ql-refile-to return)
'(("Refile bulk agenda selection to selected heading" . list)))
(_ '(("Refile heading at point to selected heading" . yant/helm-org-ql-refile-to)
("Go to heading" . yant/helm-org-ql-show-marker)))))
(org-refile-keep (and arg (equal arg 3)))
(helm-org-ql-show-paths
(lambda (width)
(let ((full-path (org-get-outline-path t t)))
(save-excursion
(save-restriction
(while (and (not (member "project" (org-get-tags nil t)))
(org-up-heading-or-point-min)))
(when (and (org-at-heading-p)
(member "project" (org-get-tags nil t)))
(setq full-path (-difference full-path (org-get-outline-path nil t))))
(org-format-outline-path full-path width nil "\\"))))))
(helm-org-ql-reverse-paths nil))
(helm-org-ql (org-agenda-files t)
:name "Refile to"
:history yant/helm-org-ql--refile-history
:filter
'(and (not (path "rss.org" "schedule.org"))
;; (todo)
(not (tags-local "NOREFILE"))
(tags-local "REFILE" "goal")
)))))
(defun yant/helm-org-ql-toggle-archives ()
"Toggle searching across archive files."
(interactive)
(with-helm-buffer
(cond
((equal helm-org-ql-buffers-files (org-agenda-files t))
(helm-set-attr 'name "Org Agenda Files and Archives")
(setq-local helm-org-ql-buffers-files (org-agenda-files t t))
(helm-update))
((equal helm-org-ql-buffers-files (org-agenda-files t t))
(helm-set-attr 'name "Org Agenda Files")
(setq-local helm-org-ql-buffers-files (org-agenda-files t))
(helm-update))
(t nil))))
:config
(bind-key "C-M-l" #'yant/helm-org-ql-yank-selection helm-org-ql-map)
(bind-key "C-c C-w" #'yant/helm-org-ql-refile org-mode-map)
(bind-key "C-c C-w" #'yant/helm-org-ql-refile org-agenda-mode-map)
(bind-key "C-c C-u" #'yant/helm-org-ql-toggle-archives helm-org-ql-map)
(add-to-list 'org-agenda-bulk-custom-functions `(?R yant/helm-org-ql-refile-to ,(apply-partially #'yant/helm-org-ql-refile 'bulk-agenda-command)))
:custom
(helm-org-ql-actions '(("Go to heading" . yant/helm-org-ql-show-marker)
("Open heading source" . yant/helm-org-ql-open-url)
("Insert link to heading" . yant/helm-org-ql-create-link)
("Insert URL of heading" . yant/helm-org-ql-insert-url)
("Refile heading(s) to heading at point" . helm-org--refile-heading-here)
("Refile heading at point to selected heading" . yant/helm-org-ql-refile-to)
("Set as blocker for heading at point" . yant/helm-org-ql-set-preceding-task)
("Show in agenda" . yant/helm-org-ql-show-in-agenda)))
)Live (helm-org-ql) search in org
(use-package helm-org-ql
:straight (helm-org-ql :type git :host github :repo "alphapapa/org-ql" :local-repo "~/Git/org-ql"
:fork (:host github :repo "yantar92/org-ql"))
:after org-ql
:custom
(helm-org-ql-reverse-paths t)
(helm-org-ql-show-paths nil)
(helm-org-ql-input-idle-delay 0.1)
:config
(require 'helm-org-ql)
(use-package boon
:config
(cl-defun yant/helm-org-ql-agenda-files (arg)
"Like `helm-org-ql-agenda-files', but also allow creating a new heading."
(interactive "P")
(let ((files (if arg (org-agenda-files t t) (org-agenda-files t)))
(search-archives-p t ;; arg
)
(helm-full-frame t))
(helm :prompt (format "Query (boolean and): ")
:sources (list (helm-org-ql-source files
:name "Org Agenda Files"
:filter (unless search-archives-p
'(not (and (not (tags-local "ARCHIVE"))
(tags "ARCHIVE"))))
:limit-count 100)
(helm-build-sync-source "Create new"
:candidates
(lambda ()
(if (string-empty-p helm-pattern)
(list "New note")
(list (format "New note: \"%s\"" (string-clean-whitespace helm-pattern)))))
:match #'identity
:match-dynamic t
:nohighlight t
:action
'(("New note" . (lambda (_)
(let ((helm-org-ql-default-title helm-pattern))
(org-capture nil "N")))))))))))
(bind-key "h" #'yant/helm-org-ql-agenda-files boon-forward-search-map))Speed up agenda generation via org-refresh-properties
One of the bottlenecks for my agenda generation is getting inherited properties. They can be cached using org-refresh-properties. In particular, I need up cache SHOWDATES and SHOWFROMTIME properties.
[2021-08-15 Sun] Disabling altogether. Should not matter as cache is enabled.
(use-package org-agenda :if init-flag :after org
:config
(setq org-agenda-ignore-properties (list 'stats))
;; (defun org-refresh-effort-properties () "Stub!" nil)
)
;; (use-package org-agenda
;; :if init-flag
;; :after org
;; :config
;; (add-to-list 'org-global-properties '("SHOWDATES" . nil))
;; (add-to-list 'org-global-properties '("SHOWFROMTIME" . nil))
;; (define-advice org-refresh-effort-properties (:after (&rest _) refresh-custom-properties)
;; "Refresh SHOWDATES and SHOWFROMTIME properties for agenda."
;; (with-silent-modifications
;; (org-with-wide-buffer
;; (remove-text-properties (point-min) (point-max) '(showdates t showfromtime t))))
;; (org-refresh-properties "SHOWDATES" 'showdates)
;; (org-refresh-properties "SHOWFROMTIME" 'showfromtime)))Speed up agenda by caching some built-in functions
(memoize-by-buffer-contents #'org-get-buffer-tags)
;; (memoize-by-buffer-contents #'org-refresh-category-properties)
;; (memoize-by-buffer-contents #'org-refresh-effort-properties)Speed up agenda by disabling cookies fontification
(setq org-agenda-fontify-priorities nil)Contacts
(use-package org-contacts
:after org
:init
(setq org-contacts-files '("/home/yantar92/Org/contacts.org"))
:config
(use-package helm-org-contacts
:straight (helm-org-contacts :host github :repo "tmalsburg/helm-org-contacts")))Column mode
(when init-flagSometimes, I forget what was happening with a task when I did it last time. Notes are useful in such a case. However, I do not find it comfortable to look into notes (which are stored in drawer) every time I come back to the task. Instead, I use column mode to show the last stored note.
Put summary on top instead, use org-agenda-show-entry-text to see it thenEND;; Set default column view headings: Task Effort Clock_Summary
(setq org-columns-default-format "%TODO %40ITEM(Task) %40SUMMARY(Summary)")
(defvar yant/last-note-taken ""
"Text of the last note taken.")
(define-advice org-agenda-add-note (:around (oldfun &optional arg) remove-summary-maybe)
"Remove SUMMARY when `org-agenda-add-note' is invoked with a prefix argument."
(interactive "P")
(unless arg (funcall oldfun arg))
(let* ((agenda-marker (point-marker))
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(inhibit-read-only t))
(when arg (org-entry-delete marker "SUMMARY"))
(if arg
(org-agenda-change-all-lines (org-with-point-at marker (org-get-heading))
(org-with-point-at marker (org-back-to-heading) (point-marker))))))
(define-advice org-store-log-note (:before (&rest args) yant/org-store-last-note)
"Store the last saved note into `yant/last-note-taken'."
(let ((txt (buffer-string)))
(while (string-match "\\`# .*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
(when (string-match "\\s-+\\'" txt)
(setq txt (replace-match " " t t txt)))
(when (string-match "\n" txt)
(setq txt (replace-match " " t t txt)))
(if (not (seq-empty-p txt))
(setq yant/last-note-taken txt))))
(define-advice org-store-log-note (:after (&rest args) yant/org-save-last-note-into-summary-prop)
"Save the last saved note into SUMMARY property."
(when (and (not org-note-abort) (not (seq-empty-p yant/last-note-taken)))
(if (eq major-mode 'org-agenda-mode)
(org-with-point-at-org-buffer
(org-set-property "SUMMARY" (or yant/last-note-taken "")))
(org-set-property "SUMMARY" (or yant/last-note-taken "")))
(setq yant/last-note-taken nil)))__epilogue
)Auto sort
(use-package org-autosort
:after org
:straight (org-autosort :local-repo "~/Git/org-autosort")
:config
(add-hook 'org-mode-hook #'org-autosort-sort-entries-in-file-maybe)
(setq org-autosort-todo-cmp-order '("WAITING" "REVIEW" "DOING" "NEXT" "HOLD" "TODO" "SOMEDAY" "TICKLER" "MERGED" "FAILED" "DONE" "CANCELLED"))
(bind-key "C-c C-S-s" 'org-autosort-sort-entries-at-point org-mode-map)
(add-to-list 'org-default-properties "SORT"))Clocking & logging
(when init-flagThe main purpose of clocking for me is to control the time I spend for important projects and for other staff (like configuring Emacs ;)). Hence, it is important to do a continuous tracking of the tasks, which I can choose to do or not to do (e.g. it is useless to keep track of how much time I spend brushing my teeth in the morning). A lot of time, the task I am doing is not useful to add to my org files explicitly (e.g. initial checks on some side project, which may or may not work; routine work). I use special tasks for all kinds of such activity:
- Organisation
- related to work, general
- Check
TORead… - related to home, browsing, reading fiction, etc I start the activity from clocking in one of these tasks. Later, I clock in the task, which I am doing at the moment. Once it’s done, clocking automatically comes back to higher level task (unless it is marked
:NOCLOCK, see General org mode tags) or to one of the tasks above when I clocked out top level project. Captures are also clocked, but once done, clocking comes back to previously active task, if any, or to default task otherwise.
(use-package org-clock
:after org
:config
(setq org-duration-format '(("h" . h:mm) ("min" . h:mm)))
(setq org-clock-out-remove-zero-time-clocks t)
(setq org-clock-out-when-done t)
(setq org-clock-in-resume t)
(setq org-clock-persist t)
(setq org-clock-auto-clock-resolution (quote when-no-clock-is-running))
(setq org-clock-persist-query-resume nil)
(org-clock-persistence-insinuate)
(defvar bh/keep-clock-running nil
"Continue in default task if no task is clocked in.")
(defvar bh/organization-task-id "Organization"
"ID of default usefull work task.")
(defvar yant/home-task-id "Homedef"
"ID of default useless activity task.")
(defun yant/punch-in-organization ()
"Clock in Organization task."
(interactive)
(setq bh/keep-clock-running 'yant/punch-in-organization)
(org-with-point-at (org-id-find bh/organization-task-id
'marker)
(org-clock-in '(16))))
(defun yant/punch-in-home ()
"Clock in home (random activity) task."
(interactive)
(setq bh/keep-clock-running 'yant/punch-in-home)
(org-with-point-at (org-id-find yant/home-task-id
'marker)
(org-clock-in '(16))))
(defun yant/punch-out nil
"Set `org-clock-default-task' to nil and clock out."
(save-excursion
(setq bh/keep-clock-running nil)
(when (org-clock-is-active)
(org-clock-out))))
(defun bh/clock-in-default-task ()
(save-excursion
(org-with-point-at org-clock-default-task
(org-clock-in))))
;; (defun bh/clock-in-parent-task ()
;; "Move point to the parent (project) task if any and does not have local tag NOCLOCK and clock in."
;; (let ((parent-task))
;; (save-mark-and-excursion
;; (save-restriction
;; (widen)
;; (while (and (not parent-task) (org-up-heading-safe))
;; (when (and (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; (not (member "NOCLOCK" (org-get-tags nil 'LOCAL))))
;; (setq parent-task (point))))
;; (if parent-task
;; (org-with-point-at parent-task
;; (org-clock-in))
;; (if bh/keep-clock-running
;; (bh/clock-in-default-task)
;; (org-clock-out)))))))
(defun yant/clock-out-maybe nil
"Clock out and clock in to default task if `bh/keep-clock-running' is not nil."
(when (and bh/keep-clock-running
(not org-clock-clocking-in)
(marker-buffer org-clock-default-task)
(not org-clock-resolving-clocks-due-to-idleness))
(bh/clock-in-default-task)))
(add-hook 'org-clock-out-hook 'yant/clock-out-maybe 'append))Once I keep all my time tracked, I can calculate the estimated balance of my time. The idea is that I assign the weight to each task/project (:ORG-TIME-BALANCE-MULTIPLIER:), which is positive for useful tasks I do not want to do, and negative for fun tasks (they may be useful, but the purpose is to force myself doing what I do not like to do). All I need to do now, is to keep this balance positive.
Agenda log mode & clock report
Reviewing previously clocked task is important to keep track of mistakes and clashes during clocking. I do it once per week.(setq org-clock-report-include-clocking-task t)
(setq org-agenda-log-mode-items (quote (closed state)))- set up consistency checks (do not show too short clocking gaps)
(setq org-agenda-clock-consistency-checks (plist-put org-agenda-clock-consistency-checks :max-gap "2:00"))
Logging
(setq org-log-into-drawer t
org-log-state-notes-insert-after-drawers t
org-log-done 'time
org-log-done-with-time t
org-log-note-clock-out nil
org-log-refile 'time
org-log-reschedule nil)
(setq org-clock-into-drawer t)- Do not create empty drawers
(defun bh/remove-empty-drawer-on-clock-out () (interactive) (save-excursion (beginning-of-line 0) (org-remove-empty-drawer-at (point)))) (add-hook 'org-clock-out-hook 'bh/remove-empty-drawer-on-clock-out 'append)
- Relative to my todo keyword structure, it make sense that clocked task is always
NEXTand scheduled
(defun bh/clock-in-to-next (kw) "Switch a task from TODO to NEXT 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)) (when (and (member (org-get-todo-state) (list "TODO" "DONE")) (bh/is-task-p)) "NEXT"))) (defun yant/schedule-maybe () "Schedule task at point for today, unless it is already scheduled." (unless (or (and (boundp 'org-capture-mode) org-capture-mode) (member "DEFAULT" (org-get-tags-at (point) 'local)) (member "project" (org-get-tags-at (point) 'local)) (not (org-get-todo-state)) (org-get-scheduled-time (point))) (org-schedule nil "."))) (setq org-clock-in-switch-to-state 'bh/clock-in-to-next) (add-hook 'org-clock-in-hook #'yant/schedule-maybe)
- Relative to my todo keyword structure, it make sense that clocked task is always
Force all custom notes to be outside drawer
Unlike automatically recorded notes about clocking or state changes, I prefer to see manually taken notes outside the LOGBOOK drawer
(define-advice org-log-into-drawer (:filter-return (result) force-notes-outside-drawer)
"Force manual notes outside drawer."
(if (eq org-log-note-purpose 'note)
nil
result))Display clocked in entry
I do not show current task in Emacs, instead I useawesome wm widget.
Hence, need to save current task in file.
The widget shows clocked time and full path to the clocked tasks (i.e. [hh:mm] Project/Subproject/Subsubproject/.../task) or [hh:mm] Capturing ... for capturing (the title is being edited there and it does not make sense to keep that updated in widget as well).
(setq org-clock-mode-line-total (quote today))
(defvar yant/org-clocking-info-file "~/.org-clock-in"
"File to save current clocking info.\nIt will be overwriten!")
(defun yant/task-fulltitle ()
"Construct full path for the task at point."
(when (fboundp 'org-mode)
(save-mark-and-excursion
(save-restriction
(org-back-to-heading t)
(format "{%s} %s" (org-get-category) (org-link-display-format (org-get-heading t t t t)))
;; (org-format-outline-path (org-get-outline-path 'with-self 'cache) 110 nil "→")
))))
(defun yant/clocked-fulltitle ()
"Construct string, describing currently clocked entry time and full path to this entry."
(if org-capture-mode
(concat "Capturing " (plist-get org-capture-plist :description) "...")
(yant/task-fulltitle)))
(setq org-clock-heading-function 'yant/clocked-fulltitle)
(defun yant/save-noclock ()
"Save info, that there is no clocked in entry."
(let ((backup-inhibited t))
(with-temp-file yant/org-clocking-info-file
(insert (format "\"No clocked in task\"\n%s" org-time-balance)))))
(defun yant/save-clocked ()
"Save current clocked state into file."
(if (org-clock-is-active)
(save-mark-and-excursion
(save-restriction
(let* ((buf yant/org-clocking-info-file)
(str (org-clock-get-clock-string))
(org-time-multiplier org-clock-multiplier)
(time-balance org-time-balance))
(with-temp-file buf
(setq-local backup-inhibited t)
(insert (format "%s\n%s\n%s" str time-balance org-time-multiplier))))))
(yant/save-noclock))
(async-start-process "Update balance widget" "balance-monitor.sh" #'ignore))
(add-hook 'org-clock-in-hook 'yant/save-clocked 'append)
(add-hook 'org-clock-out-hook 'yant/save-clocked 'append)
(add-hook 'org-clock-cancel-hook 'yant/save-clocked 'append)Efforts
For a long time, I did not find any use for effort estimates. However, they do have uses in my workflow.
A frequent statement about effort estimates is that if you think that estimate is too much, you just split the task. However, even just the process of splitting generally takes unpredictable time when the task is an exploratory task. For me, as a researcher, such tasks are pretty common. I sometimes have a very rough idea about what should be done and cannot predict how much time each step of a research project is going to take. Things in research fail more often than not and a trivial task may turn out to take 10 times more time that expected. An alternative approach to setting efforts is coming from timeboxing approach when a task is expected to be worked on for a certain period of time per day. However, working on some tasks in research, I can often get a momentum and work on a single task for a single day. Notifications for exceeding the effort are unwanted in such scenario. On the other hand, some tasks may be very difficult to start and not having any time estimate on the task may be discouraging (if there was an effort, at least one can convince himself to work on such task for some time). Hence, setting some effort estimate on stale tasks is useful.
- When a task is very large, but cannot be splitted, it is useful to dedicate certain time I plan to spend working on the task. Having this time really helps to start working on the task since I am not demoralised by size of the task. Such tasks are marked with
DOINGtodo keyword (see #todo_keyword #DOING). This can also be used to establish hard habits [[id:cf61cb2670daec785acaf2f7bdd26417c33b36f4][Christine Carter [TED] (2021) The 1-minute secret to forming a new habit]]. - Because of structure of my agenda (see Focused daily agenda), I often arrive to my list of NEXT tasks late in the evening. However, many of those tasks are not quite easy to do and I am too tired to start them. In these cases, it is useful to filter the agenda showing NEXT tasks only to “easy” tasks, which do not take too much time/effort. Effort estimates can be used in such scenario to mark tasks, which will take a long time (1 hour of longer). I can then simply filter agenda by effort less than one hour to quickly get the tasks I can do when I am tired (but not tired enough to not do anything).
I would like to highlight that this second use-case is extremely important to avoid spending time mindlessly browsing websites like YouTube or reddit. I’d better do something easy yet potentially useful than spend time in completely useless manner.
Notify when clocked in time exceeds effort estimate
[2020-05-03 Sun] Mode-line display is also linked to notification when the clocked-in time exceeds effort estimate. Hence, I still display the task in mode-line for the sole purpose of enabling notification.
report in mail-list about mode-line display dependence of effort notificationEND(use-package org-clock
:after org
:if init-flag
:config
(use-package pomidor
:defer t
:config
(setq org-clock-sound pomidor-sound-overwork))
(unless org-clock-sound (setq org-clock-sound "~/Org/alert.wav"))
;; this is not a default value, 't will still trigger notification
;; when clocked in time exceeds effort estimate, while not triggering
;; showing the current task in modeline or frame title.
(setq org-clock-clocked-in-display 't))Effort filtering in agenda views
By default, no effort is considered as very difficult by agenda. However, most of my tasks do not have efforts by default. When I filter by effort in agenda, it is more useful to see tasks without effort listed as “easy” - I can put large effort when necessary.
(setq org-agenda-sort-noeffort-is-high nil)Clocking history
Sometimes I need to jump to some urgent task. After it is done, I hate searching for the last task buffer and start clocking it again. Hence, I use clocking history and quick key combination to clock in task from recent clocked in tasks.(setq org-clock-history-length 23)
(use-package boon
:config
(use-package helm-org
;; :bind (:map boon-goto-map
;; ("p" . helm-org-agenda-files-headings))
:after org
:config
(defun dfeich/helm-org-clock-in (marker)
"Clock into the item at MARKER"
(with-current-buffer (marker-buffer marker)
(goto-char (marker-position marker))
(org-clock-in)))
(nconc helm-org-headings-actions
(list
(cons "Clock into task" #'dfeich/helm-org-clock-in)))
(bind-key "C-c i" #'dfeich/helm-org-clock-in helm-org-headings-map)
(setq helm-org-format-outline-path t
helm-org-show-filename t
helm-org-ignore-autosaves t)
))Automatic clock-out on idle
Sometimes, I clock in some task in the evening, but fall asleep. That excess clocked time is not useful. So, let Emacs automatically clock out the current task when Emacs is idle for a long time [2020-12-20 Sun] It creates huge number of dangling clocks, probably affecting performance. Disabling
(use-package org-clock
:if init-flag
:after org
:custom
(org-clock-auto-clockout-timer (* 60 60 2)) ; 2 hours
:config
(org-clock-auto-clockout-insinuate))Pomodoro technique
Sometimes I need to do important task, but I just hate it. I tend to do anything, but not that freaking task. In this case,pomodoro works for me - I just switch between the task and something I like.
About: habr
(use-package pomidor
:if init-flag
:straight t
:bind (([f7] . pomidor))
:config
(setq alert-default-style 'libnotify))Bonus/penalty based time management
The idea is to assign time bonus/penalty during working on different tasks, so that the total balanced time spent under all the tasks (org-time-balance) is kept positive.
Similar concept is described here.
I calculate the effective time by setting ORG-TIME-BALANCE-MULTIPLIER property for various tasks.
If the value is positive then the task is useful. Otherwise, it is negative and I do not want to spend too much time doing such tasks.
The property can be different for various classes of tasks allowing to avoid/promote doing various tasks.
Setting ORG-TIME-BALANCE-MULTIPLIER for every single task is annoying, so I make it inherited during calculation.
It does not make sense to set ORG-TIME-BALANCE-MULTIPLIER for tasks like buying something in the shop.
I just do not clock them in.
Instead, I use ORG-TIME-BONUS-ON-DONE property to add fixed extra time for finishing the task (only DONE keyword is considered).
Also, during exceptionally procrastinated days time balance may go overboard and become terribly negative. If the balance becomes too negative, it is infuriating to see how much I need to makeup. The solution is introducing the idea of lossage. When time balance becomes too negative, it is no longer decreased, but the lossage is increased. Later, when the time balance becomes large and positive, it stops growing until the lossage is back to 0.
Similar idea is used by John Wiegley in Emacs SF: 2019-07-24: All Things Org-Mode - Multiple Speakers He tracks his clocking time daily to have an idea how long he worked relative to his daily goal (8 hours). This idea is not applicable for my work though. Research is often not regularly structured - I can work during weekdays, weekends, at night time when I suddenly get some idea, etc. In such a way, it is important for me to maintain some average work/leisure balance rather than work certain number of hours every workday.
the bonus cannot be correctly handled when we need to update the time after certain pointEND(defvar org-time-balance nil
"Weighted time spent for all the tasks in agenda files.")
(defvar org-time-balance-persistant-p t
"Non nil means that `org-time-balance' is saved between emacs sessions.")
(defvar org-time-balance-save-time nil
"Time of the last save of `org-time-balance'.")
(defvar org-time-balance-update-time nil
"Time of the last update of `org-time-balance'.")
(defvar org-time-balance-storage (concat user-emacs-directory ".org-time-balance")
"File used to store time balance between sessions.")
(use-package no-littering
:config
(setq org-time-balance-storage (concat no-littering-var-directory "org-time-balance-storage.el")))
(defvar org-time-balance-lower-bound (* 60 4 -1) ; -4 hours
"Lower bound of possible value of time balance.")
(defvar org-time-balance-lossage nil
"Time lossage accumulating when `org-time-balance' reaches `org-time-balance-lower-bound'.")
(defvar org-time-balance-upper-bound (* 60 10) ; 10 hours
"Upper bound of possible value of time balance when `org-time-balance-lossage' is positive.
Growing time balance will be reducing `org-time-balance-lossage' when
`org-time-balance' exceeds this value and `org-time-balance-lossage'
is positive.")
(defvar org-time-balance-upper-bound-rigid (* 60 30) ; 30 hours
"Rigit upper bound of possible value of time balance.
Growing time balance will be reducing `org-time-balance-lossage' when
`org-time-balance' exceeds this value.")
(defun org-load-time-balance-session ()
"Load the current org-time-balance if `org-time-balance-persistant-p' is non nil."
(if (not org-time-balance-persistant-p)
(setq org-time-balance 0
org-time-balance-lossage 0)
(load org-time-balance-storage)
(unless org-time-balance (setq org-time-balance 0))
(unless org-time-balance-lossage (setq org-time-balance-lossage 0))
(message "Loading time-balance... %d hours" (/ org-time-balance 60))))
(defun org-save-time-balance-session ()
"Save the current org-time-balance if `org-time-balance-persistant-p' is non nil."
(when (and org-time-balance-persistant-p
org-time-balance)
(setq org-time-balance-save-time (or org-time-balance-update-time (current-time)))
(with-temp-file org-time-balance-storage
(insert "(setq org-time-balance " (prin1-to-string org-time-balance) ")" "\n")
(insert "(setq org-time-balance-lossage " (prin1-to-string org-time-balance-lossage) ")" "\n")
(insert "(setq org-time-balance-save-time '" (prin1-to-string org-time-balance-save-time) ")"))))
(defun org-get-time-balance-multiplier-at-point ()
"Get value of :ORG-TIME-BALANCE-MULTIPLIER property of an item at point or return 1."
(save-excursion
(save-restriction
(let ((multiplier (org-entry-get (point) "ORG-TIME-BALANCE-MULTIPLIER" 'inherit)))
(if (seq-empty-p multiplier)
1
(string-to-number multiplier))))))
(defun org-get-org-time-bonus-on-done-at-point ()
"Get value of :ORG-TIME-BONUS-ON-DONE: property of an item at point or return 0."
(save-excursion
(save-restriction
(let ((bonus (org-entry-get (point) "ORG-TIME-BONUS-ON-DONE")))
(if (seq-empty-p bonus)
0
(string-to-number bonus))))))
(defun org-get-org-time-bonus-at-point ()
"Get time bonus on done for an item at point.
Return the value of :ORG-TIME-BONUS: property and,
if the item has DONE keyword, add :ORG-TIME-BONUS-ON-DONE:.
Increment :ORG-TIME-BONUS: for habits, if nesessary."
(save-excursion
(save-restriction
(let* ((bonus (org-entry-get (point) "ORG-TIME-BONUS"))
(bonus (if (seq-empty-p bonus)
0
(string-to-number bonus)))
(extra (if (string= (org-get-todo-state) "DONE")
(org-get-org-time-bonus-on-done-at-point)
0)))
(+ bonus extra)))))
(defun org-clock-sum-current-entry-only (&optional tstart)
"Return time, clocked on current item in total. Exclude subitems."
(save-excursion
(save-restriction
(if (or (org-inlinetask-at-task-p)
(org-inlinetask-in-task-p))
(narrow-to-region (save-excursion (org-inlinetask-goto-beginning) (point))
(save-excursion (org-inlinetask-goto-end) (point)))
(org-narrow-to-subtree)
(goto-char (point-min))
(outline-next-heading)
(narrow-to-region (point-min) (point)))
(org-clock-sum tstart)
org-clock-file-total-minutes)))
(defun org-time-balance-update-lossage ()
"Update `org-time-balance-lossage'."
(when (< org-time-balance org-time-balance-lower-bound)
(setq org-time-balance-lossage (+ org-time-balance-lossage (- org-time-balance-lower-bound org-time-balance)))
(setq org-time-balance org-time-balance-lower-bound))
(when (and (> org-time-balance-lossage 0)
(> org-time-balance org-time-balance-upper-bound))
(setq org-time-balance-lossage (- org-time-balance-lossage (- org-time-balance org-time-balance-upper-bound)))
(setq org-time-balance org-time-balance-upper-bound))
(when (> org-time-balance org-time-balance-upper-bound-rigid)
(setq org-time-balance-lossage (- org-time-balance-lossage (- org-time-balance org-time-balance-upper-bound-rigid)))
(setq org-time-balance org-time-balance-upper-bound-rigid)))
(defun org-accumulate-weighted-time (&optional return)
"Aggregate `org-time-balance' counter at point from the last save or for all the time.
Use :ORG-TIME-BALANCE-MULTIPLIER: property to set the weight.
Just return the value at point if RETURN is not nil."
(when org-time-balance
(let* ((value-at-point (* (org-clock-sum-current-entry-only org-time-balance-update-time)
(org-get-time-balance-multiplier-at-point))))
(setq value-at-point (+ value-at-point (org-get-org-time-bonus-at-point)))
(if return
value-at-point
(setq org-time-balance (+ org-time-balance value-at-point))
(org-time-balance-update-lossage)))))
(defun org-get-total-weighted-time (&optional force)
"Calculate total weighted time clocked in all agenda files.
Ignore current value of `org-time-balance' if FORCE is not nil.
If FORCE is non nil recalculate the time in all the agenda files
ignoring the previously saved values."
(when (or force (not org-time-balance))
(message "Updating org-time-balance...")
(setq org-time-balance 0)
(setq org-time-balance-save-time nil)
(unless force (org-load-time-balance-session))
(when (not org-time-balance-save-time) ;; FIXME: temporary fix to avoid accumulating bonus time after loading saved balance
(cl-loop for file in (org-agenda-files 'unrestricted t) do
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(cl-loop until (eobp)
do (when (outline-next-heading)
(org-accumulate-weighted-time))))))
(message "Updating org-time-balance... %d hours" (/ org-time-balance 60))
(setq org-time-balance-update-time (current-time)))
org-time-balance)
(define-advice org-clock-out (:around (OLDFUN &rest args) yant/org-increment-weighted-time)
"Add the current clock time to `org-time-balance'."
(unless org-time-balance
(setq org-time-balance (org-get-total-weighted-time))
(org-time-balance-update-lossage))
(when (org-clocking-buffer)
(save-excursion ; Do not replace this with `with-current-buffer'.
(with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(use-package org-clock)
(goto-char org-clock-marker)
(let ((old-time-at-point (org-accumulate-weighted-time 'return))
(old-org-time-balance org-time-balance))
(apply OLDFUN args)
;; (setq org-time-balance-update-time (current-time))
(setq org-time-balance (+ old-org-time-balance
(- (org-accumulate-weighted-time 'return)
old-time-at-point)))
(org-time-balance-update-lossage))))))
(define-advice org-todo (:around (OLDFUN &optional arg) yant/org-increment-weighted-time)
"Probably add the current item time bonus to `org-time-balance'."
(unless org-time-balance
(setq org-time-balance (org-get-total-weighted-time))
(org-time-balance-update-lossage))
(org-with-point-at-org-buffer
(let ((old-time-at-point (org-accumulate-weighted-time 'return))
(old-org-time-balance org-time-balance))
(when (and (string= (org-entry-get (point) "STYLE") "habit")
(string= (format "%s" arg) (org-entry-get (point) "REPEAT_TO_STATE"))
(string= "DONE" (org-get-todo-state))
(org-set-property "ORG-TIME-BONUS" (format "%s" (org-get-org-time-bonus-at-point)))))
(apply OLDFUN (list arg))
;; (setq org-time-balance-update-time (current-time))
(setq org-time-balance (+ old-org-time-balance
(- (org-accumulate-weighted-time 'return)
old-time-at-point)))
(org-time-balance-update-lossage))
(yant/save-clocked)))
(defvar org-clock-multiplier 0
"Multiplier of the currently clocked entry.")
(defun org-clock-save-clock-multiplier ()
"Save value of :ORG-TIME-BALANCE-MULTIPLIER: of the item at point to `org-clock-multiplier'."
(org-with-wide-buffer
(org-get-total-weighted-time)
(setq org-clock-multiplier (or (org-entry-get (point) "ORG-TIME-BALANCE-MULTIPLIER" 'inherit)
1))))
(add-hook 'org-clock-in-hook #'org-clock-save-clock-multiplier)
(add-hook 'org-clock-in-hook #'org-save-time-balance-session)
(add-to-list 'org-default-properties "ORG-TIME-BALANCE-MULTIPLIER")
(add-to-list 'org-default-properties "ORG-TIME-BONUS-ON-DONE")Clocked time visualisation
rksm/clj-org-analyzer: Fun with org data is a java program that parses org files for clocking data and provide a nice web interface to visualise the data. The clock summary can be limited to certain tags to heading text search.
(use-package org-analyzer
:commands org-analyzer-start
:straight t)__epilogue
)Capture
(when init-flag
(use-package org-capture
:after org
:configCapturing is an important part of my workflow. It allows me to quickly note down the task or thought for future consideration and continue the current task. This should be done quickly, and from any place (not only from inside emacs):
- system wide key combination for capturing allows to capture from anywhere
- open new frame for capturing
- use capture templates for most common types of quick captures
There is also one more use case when I prefer to use capture - creating a new big projects. The reason to use capture here is that common types of projects require some set of needed actions, which I tend to forget. Capture templates here allows to remind necessary project tasks to myself.
System wide capture
(use-package org-protocol
:after org)- State “DONE” from [2018-09-23 Sun 17:36]
(use-package org-capture-pop-frame
:after org
:straight t
:config
(setq ocpf-frame-parameters '((name . "org-capture-pop-frame")))
(defadvice org-capture-place-template (after delete-windows activate) (delete-other-windows))
(defadvice org-capture-select-template (around delete-capture-frame activate)
"Advise org-capture-select-template to close the frame on abort. From https://stackoverflow.com/questions/23517372/hook-or-advice-when-aborting-org-capture-before-template-selection#23517820"
(unless (ignore-errors ad-do-it t)
(setq ad-return-value "q"))
(if (and (equal "q" ad-return-value)
(equal "org-capture-pop-frame" (frame-parameter nil 'name)))
(delete-frame))))Currently org-capture-pop-frame resets the line truncation state, which is rather annoying. Denying it:
(use-package org-capture-pop-frame
:if init-flag
:defer t
:init
(defun ocpf--org-capture (orig-fun &optional goto keys)
"Create a new frame and run org-capture."
(interactive)
(let ((frame-window-system
(cond ((eq system-type 'darwin) 'ns)
((eq system-type 'gnu/linux) 'x)
((eq system-type 'windows-nt) 'w32)))
(after-make-frame-functions
#'(lambda (frame)
(with-selected-frame frame
(funcall orig-fun goto keys)
;; (setq header-line-format
;; (list "Capture buffer. "
;; (propertize (substitute-command-keys "Finish \\[org-capture-finalize], ")
;; 'mouse-face 'mode-line-highlight
;; 'keymap
;; (let ((map (make-sparse-keymap)))
;; (define-key map [header-line mouse-1] 'org-capture-finalize)
;; map))
;; (propertize (substitute-command-keys "abort \\[org-capture-kill]. ")
;; 'mouse-face 'mode-line-highlight
;; 'keymap
;; (let ((map (make-sparse-keymap)))
;; (define-key map [header-line mouse-1] 'org-capture-kill)
;; map))))
))))
(make-frame
`((window-system . ,frame-window-system)
,@ocpf-frame-parameters)))))Capture templates
To simplify defining the capture templates, I use doct package #doct
(use-package doct
:straight (doct :type git :host github :repo "progfolio/doct")
:commands (doct))Also, use yasnippet during capture #yasnippet
(use-package ya-org-capture
:straight (ya-org-capture :type git :host github :repo "ag91/ya-org-capture" :local-repo "~/Git/ya-org-capture"
:fork (:host github :repo "yantar92/ya-org-capture"))
:after org
:config
(ya-org-capture/setup))All these templates generally record the creation time in :CREATED:
TODO item
# -*- mode: snippet -*-
# name: todo_capture
# key: todo_capture_
# --
TODO ${1:Title} ${2:`(s-trim-right (org-capture-fill-template "%a"))`}
:PROPERTIES:
:CREATED: `(s-trim-right (org-capture-fill-template "%U"))`
:END:
${3:`(yant/org-capture-followup-string)`}
$0
(defun yant/org-capture-followup-string ()
"Create reference string to currectly clocked entry."
(if (not (marker-buffer org-clock-marker))
""
(let ((current-task (org-with-point-at org-clock-marker
(unless (or (member "DEFAULT" (org-get-tags nil 'local))
(member "NOFOLLOW" (org-get-tags nil 'local)))
(let (org-store-link-plist org-stored-links)
(org-store-link nil))))))
(if current-task
(format "- Following up :: %s" current-task)
""))))
(use-package ya-org-capture
:defer t
:config
(asoc-put! org-capture-templates
"n"
(cdar (doct
'("NEXT item"
:keys "n"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"todo_capture_\")"))))))Singular TODO item
Normal TODO item with time bonus on done (20 minutes) Used for the items, which are unlikely to be time tracked
# -*- mode: snippet -*-
# name: todo_singular_capture
# key: todo_singular_capture_
# --
TODO ${1:Title} `(s-trim-right (org-capture-fill-template "%a"))`
:PROPERTIES:
:CREATED: `(s-trim-right (org-capture-fill-template "%U"))`
:ORG-TIME-BONUS-ON-DONE: 20
:END:
$0
(asoc-put! org-capture-templates
"t"
(cdar (doct '("Singular TODO item"
:keys "t"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"todo_singular_capture_\")"))))
'replace)Note
A note, which is not actionable or expected to contain a lot of text
# -*- mode: snippet -*-
# name: note_capture
# key: note_capture_
# --
TODO ${1:`(or (and (boundp 'helm-org-ql-default-title) (not (string-empty-p helm-org-ql-default-title)) helm-org-ql-default-title) (concat "Fleeting note on " (s-trim-right (org-capture-fill-template "%u"))))`} :note:
:PROPERTIES:
:CREATED: `(s-trim-right (org-capture-fill-template "%U"))`
:END:
- [ ] Check what notes are followed by this link
- [ ] Make title
- [ ] Refile to relevant topics
- [ ] Elaborate
${2:Following up: `(s-trim-right (org-capture-fill-template "%a"))`}
$0
(asoc-put! org-capture-templates
"N"
(cdar (doct
'("Note"
:keys "N"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"note_capture_\")"))))
:replace)Habit
I default it to no logging.
(asoc-put! org-capture-templates
"h"
(cdar (doct '("Habit"
:keys "h"
:type entry
:file "~/Org/inbox.org"
:template
("* NEXT %?"
"SCHEDULED: <%<%Y-%m-%d %a .+1d>>"
":PROPERTIES:"
":CREATED: %U"
":STYLE: habit"
":REPEAT_TO_STATE: NEXT"
":LOGGING: DONE(!)"
":ARCHIVE: %%S_archive_%%y.org::*Habits"
":ORG-TIME-BONUS-ON-DONE: 20"
":END:"
"\n"))))
'replace)Meeting/Event
Scheduled event. It is saved to org-gcal org file.
(asoc-put! org-capture-templates
"M"
(cdar (doct '("Scheduled event/meeting"
:keys "M"
:type entry
:file "~/Org/schedule.org"
:template
("* %? :%^G:"
"%^T"
"\n"))))
'replace)Area of interest
An area of knowledge I am interested in. Unlike project, this does not have a concrete outcome, but can be infinite depending on my interest in the topic.
(asoc-put! org-capture-templates
"R"
(cdar (doct '("Area of interest"
:keys "R"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:category
(lambda () (or (plist-get (plist-get org-capture-plist :doct-custom) :category-string)
(progn
(setf (plist-get (plist-get org-capture-plist :doct-custom)
:category-string)
(completing-read
"Category: "
(org-ql-select (org-agenda-files t t)
'(property "CATEGORY")
:action (lambda () (substring-no-properties (org-entry-get (point) "CATEGORY"))))))
(plist-get (plist-get org-capture-plist :doct-custom)
:category-string))))
:area-title
(lambda () (or (plist-get (plist-get org-capture-plist :doct-custom) :title-string)
(progn
(setf (plist-get (plist-get org-capture-plist :doct-custom)
:title-string)
(completing-read
"Area title: "
(org-ql-select (org-agenda-files t t)
'(tags-local "AREA" "project")
:action (lambda () (substring-no-properties (org-get-heading t t t t))))))
(plist-get (plist-get org-capture-plist :doct-custom)
:title-string))))
:template
("* TODO %{area-title} :AREA:NOREFILE:"
":PROPERTIES:"
":CREATED: %U"
":ORG-TIME-BALANCE-MULTIPLIER: %^{Time balance multiplier}"
":CATEGORY: %{category}[T]"
":END:"
"# Summary note about the area. Should be updated regularly."
"\n%?"
""
"** NEXT Refile relevant bookmarks/tasks to new area %{area-title}"
"** Notes :REFILE:"
"# Notes about what I think about the topic\n"
"** Bookmarks \ references :NOARCHIVE:REFILE:"
"# Notes about what is known about the topic\n"
"** No deadline :NODEADLINE:SKIP:REFILE:"
":PROPERTIES:"
":LOGGING: DONE(!) FAILED(!) MERGED(!) WAITING(!) HOLD(!) CANCELLED(!)"
":CATEGORY: %{category}[D]"
":END:"
"*** NEXT Refile relevant tasks from more generic topics into %{area-title}"
))))
'replace)Project
A large task that needs to be studied systematically. It has to have a concrete outcome
(asoc-put! org-capture-templates
"P"
(cdar (doct '("Research project"
:keys "P"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* TODO %^{Project title} :%^G:project:"
":PROPERTIES:"
":CREATED: %U"
":ORG-TIME-BALANCE-MULTIPLIER: %^{Time balance multiplier}"
":CATEGORY: %^{Category}"
":END:"
" #project"
"# A short summary about the project."
"\n%?"
"** TODO Notes :REFILE:"
"# Notes about what I think about the topic\n"
"** TODO Bookmarks \ references :NOARCHIVE:REFILE:"
"# Notes about what is known about the topic\n"
"** NEXT Action plan :NOARCHIVE:REFILE:"
"# Action plan to complete the project.\n"
"*** NEXT Add tasks to the project and refile relevant info/tasks"
"** Sample condition :REFILE:NOARCHIVE:"
"# Limited resources I need to complete the project."
"** Methods :REFILE:NOARCHIVE:"
"# Nontrivial methods used to execute the action plan."
"** Exp data :REFILE:NOARCHIVE:"
"# The raw experimental data is stored here on per-experiment basis"
"** Results :REFILE:"
"# The raw data is analysed here to be put into human-readable form (in non-trivial ways)."
"# The data is organised by sample rather than by experiment to avoid dealing with experimental note mess."
"# Plots, important observations and thoughs are coming here.\n"
"** Paperwork :REFILE:"
"** Presentations :REFILE:"
"** NEXT No deadline :NODEADLINE:SKIP:REFILE:"
":PROPERTIES:"
":LOGGING: DONE(!) FAILED(!) MERGED(!) WAITING(!) HOLD(!) CANCELLED(!)"
":END:"))))
'replace)
(asoc-put! org-capture-templates
"G"
(cdar (doct '("General project"
:keys "G"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* TODO #project %^{Project title} :%^G:project:"
":PROPERTIES:"
":CREATED: %U"
":ORG-TIME-BALANCE-MULTIPLIER: %^{Time balance multiplier}"
":CATEGORY: %^{Category}"
":END:"
"# A short summary about the project."
"\n%?"
"** TODO Notes :REFILE:"
"# Notes about what I think about the topic\n"
"** TODO Bookmarks \ references :NOARCHIVE:REFILE:"
"# Notes about what is known about the topic\n"
"** NEXT Action plan :NOARCHIVE:REFILE:"
"# Action plan to complete the project.\n"
"*** NEXT Add tasks to the project and refile relevant info/tasks"
"** Methods :REFILE:NOARCHIVE:"
"# Nontrivial methods used to execute the action plan."
"** NEXT No deadline :NODEADLINE:SKIP:REFILE:"
":PROPERTIES:"
":LOGGING: DONE(!) FAILED(!) MERGED(!) WAITING(!) HOLD(!) CANCELLED(!)"
":END:"))))
'replace)Conference presentation/poster
(asoc-put! org-capture-templates
"p"
(cdar (doct '("Conference presentation/poster"
:keys "p"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* NEXT #%^{type|presentation|poster} %^{Title of presentation/poster} :project:conference:NOARCHIVE:"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
"** NEXT Abstract"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Submit abstract"
"DEADLINE: %^t"
"** TODO Get accepted"
"** TODO Paperwork"
"*** TODO Register for the conference"
"*** TODO Apply for conference funding"
"*** TODO Book a flight"
"*** TODO Book accomodation"
"** TODO Presentation draft"
"** TODO Trial presentation"
"** TODO Print poster/slides"
"** TODO Present"
"** TODO Submit the claim"
"** Get reimbursement"))))
'replace)Research publication
(asoc-put! org-capture-templates
"J"
(cdar (doct '("Journal publication"
:keys "J"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* NEXT #paper %^{Aproximate title of the paper} :publication:project:NOARCHIVE:"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
"\n%?"
"** NEXT Outline"
"DEADLINE: %^t"
"*** TODO Abstract"
"*** NEXT Introduction"
"*** TODO Methods"
"*** TODO Results"
"*** TODO Discussion"
"*** TODO Conclusions"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Cover letter"
"** TODO Submit"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Get accepted"
"** TODO Publish on ArXiv"
"** TODO Get published"
"** TODO Add to publication list"
"** TODO Add to XJTU university system [[id:83411a7a-dc7b-4fda-be54-4dd6aeaf58b0][XJTU: Documents and application website]]"))))
'replace)Co-authored research publication
(asoc-put! org-capture-templates
"A"
(cdar (doct '("Co-authored journal publication"
:keys "A"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* NEXT %^{Aproximate title of the paper} :publication:project:NOARCHIVE:"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
" #paper #co-author"
"\n%?"
"** Paper versions"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Submit"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Check references"
"** TODO Get accepted"
"** TODO Get published"
"** TODO Add to publication list"
"** TODO Add to XJTU university system [[id:83411a7a-dc7b-4fda-be54-4dd6aeaf58b0][XJTU: Documents and application website]]"))))
'replace)Research funding application
(asoc-put! org-capture-templates
"F"
(cdar (doct '("Funding/grant application"
:keys "F"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* TODO %^{Project title} :%^G:NOARCHIVE:grant:proposal:project:"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
"# A short summary about the proposal."
"# Reference proposal template: [[att-id:a4b82837-bc08-47b5-91fa-edd738468f1c:application2.pdf][att-id:Example of funding application to NSFC]]"
"# I should not forget next time that I will need to fill a form and get the school stamp before submitting the proposal for initial review."
" #project_proposal #grant #funding_application #NSFC"
"\n%?"
"** TODO *Important*, at least a week before deadline Prepare university intellectual property paperwork"
"- [ ] get supervisor's signature"
"- [ ] get school approval"
"** TODO Proposal outline"
"*** TODO Budget"
"*** TODO Research profile"
"*** TODO Summary"
"*** NEXT Introduction and motivation of research"
"# Link to example: [[att-id:a4b82837-bc08-47b5-91fa-edd738468f1c:Ihor-2019-final2.pdf][#proposal Self-ion irradiation damage in additive manufactured single crystalline Ni-based superalloy DD407:Ihor-2019-final2.pdf]]"
"*** TODO Research goal, objective, and content"
"**** Research goal"
"**** Research objective"
"**** Details of how to solve the research objective"
"*** TODO Research plan and practicability analysis"
"**** Research plan"
"**** Practicability analysis"
"*** TODO Unique features and innovation point"
"*** TODO Annual research plan and expected results (including the activity of academic exchange, international collaboration, etc.)"
"*** TODO Background, prior work, and availability of equipment"
"**** Research background or prior work related to the proposal"
"**** Availability of equipment"
"*** TODO References"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Submit proposal to university review"
"** TODO Submit the grant application"
"** Get accepted"))))
'replace)Research funding application (short)
(asoc-put! org-capture-templates
"f"
(cdar (doct '("Funding/grant application (small/postdoc)"
:keys "f"
:type entry
:file "~/Org/inbox.org"
:clock-in t
:clock-resume t
:template
("* TODO %^{Project title} :%^G:NOARCHIVE:grant:proposal:project:"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
"# A short summary about the proposal."
"# Reference proposal template: [[att-id:83877bd0-dcd1-4b4e-a704-613efba2809f:Proposal-Radchenko Ihor-010201.doc][att-id:Example of funding application for postocs]]"
"# I should not forget next time that I will need to fill a form and get the school stamp before submitting the proposal for initial review."
" #project_proposal #grant #funding_application #postdoc"
"\n%?"
"** TODO *Important*, at least a week before deadline Prepare university intellectual property paperwork"
"- [ ] get supervisor's signature"
"- [ ] get school approval"
"** TODO Proposal outline"
"*** TODO Summary"
"*** TODO Project research plan"
"**** TODO Research goal"
"**** TODO Research content"
"**** TODO Research methods or technical routes to be adopted"
"**** TODO Research plan and expected progress"
" *Research plan*"
""
" *Expected progress*"
"*** TODO Research basis / motivation + References"
"**** TODO Introduction / motivation"
"**** TODO References"
"*** TODO Project innovation"
"*** TODO Budget"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Submit proposal to university review"
"** TODO Submit the grant application"
"** Get accepted"))))
'replace)New contact
(asoc-put! org-capture-templates
"C"
(cdar (doct '("Contact"
:keys "C"
:type entry
:file "~/Org/contacts.org"
:template
("* %(org-contacts-template-name) %?"
":PROPERTIES:"
":CREATED: %U"
":EMAIL: %(org-contacts-template-email)"
":END:"))))
'replace)Experimental note
Should be captured to current project directlyEND(asoc-put! org-capture-templates
"E"
(cdar (doct '("Experiment note"
:keys "X"
:type entry
:file "~/Org/inbox.org"
:template
("* TODO %u %^{Experiment title}"
":PROPERTIES:"
":CREATED: %U"
":END:"
"- [ ] copy the data to my laptop"
"- [ ] update sample condition in the project notes"
"%?"))))
'replace)Reverse the order of template to make them appear as I put them in the list above
(setq org-capture-templates (nreverse org-capture-templates))Capturing references (websites, journal papers, files, etc)
When capturing external resources like URLs, journal articles or just some data, I prefer to have as much information as possible to be parsed and downloaded automatically, so that I do not need to bother adding it by hand. However, capturing URLs from youtube, scientific journal websites, imdb, goodreads, etc requires very different types of parsing. I need a per-site parsers to capture data in unified manner.
All the data captured in this way is stored in bibtex files for future reference and to integrate things with Org-ref.
The most common type of data I capture is indeed links from browser. I define two link types for capturing:
- Link from browser
- It has
:SOURCE:with URL of the page and page title in headline.:SOURCE:is the only place, where the URL is shown. I tag the entry with tagBOOKMARKto make it clear. - Generic link
- Same as link from browser, but silent (don’t raise the capture buffer)
(use-package org-capture-ref
:if init-flag
:load-path "~/Git/org-capture-ref/"
:after (org-capture org-ref)
:demand t
:init
(use-package ol-bibtex
:custom
(org-bibtex-key-property "ID"))
(use-package bibtex
:custom
(bibtex-autokey-titleword-separator "-")
(bibtex-autokey-year-title-separator "-")
(bibtex-autokey-titleword-length 'inf)
(bibtex-autokey-titlewords 3))
:config
(org-capture-ref-set-capture-template)
(let ((templates (doct '( :group "Browser link"
:type entry
:file "~/Org/inbox.org"
:fetch-bibtex (lambda () (org-capture-ref-process-capture)) ; this must run first
:link-type (lambda () (org-capture-ref-get-bibtex-field :type))
:before-finalize (lambda ()
(when (string= "video" (org-capture-ref-get-bibtex-field :typealt))
(org-set-tags (seq-union (org-get-tags nil t) (list "@home")))))
:extra (lambda () (if (org-capture-ref-get-bibtex-field :journal)
(s-join "\n"
'("- [ ] download and attach pdf"
"- [ ] [[elisp:org-attach-open][read paper capturing interesting references]]"
"- [ ] [[elisp:(browse-url (url-encode-url (format \"https://www.semanticscholar.org/search?q=%s\" (org-entry-get nil \"TITLE\"))))][check citing articles]]"
"- [ ] [[elisp:(browse-url (url-encode-url (format \"https://www.connectedpapers.com/search?q=%s\" (org-entry-get nil \"TITLE\"))))][check related articles]]"
"- [ ] check if bibtex entry has missing fields"
"- [ ] Consider subscribing to new citations"))
""))
:followup (lambda () (yant/org-capture-followup-string))
:org-entry (lambda () (org-capture-ref-get-org-entry))
:template
("%{fetch-bibtex}* TODO %?%{space}%{org-entry}"
"%{extra}"
"%{followup}")
:children (("Interactive link"
:keys "b"
:space " "
)
("Silent link"
:keys "B"
:space ""
:immediate-finish t))))))
(dolist (template templates)
(asoc-put! org-capture-templates
(car template)
(cdr template)
'replace))))- Link to email
- It has
:EMAIL-SOURCE:with link tonotmuchemail (more about working with emails in Notmuch interaction). I also mark with tagEMAIL.
(let ((templates (doct '( :group "Email"
:type entry
:file "~/Org/inbox.org"
:immediate-finish t
:template
("* TODO #email %:from %:subject :EMAIL:"
":PROPERTIES:"
":CREATED: %U"
":EMAIL-SOURCE: %l"
":Source: %:fromaddress"
":END:")
:children (("Interactive email"
:clock-in t
:clock-resume t
:keys "E"
)
("Silent email"
:keys "e"
:space ""
:immediate-finish t))))))
(dolist (template templates)
(asoc-put! org-capture-templates
(car template)
(cdr template)
'replace)))))Do not keep website text together with personal notes
For some time, I was trying to scrape the website text in addition to the title. However, it turned out to mess the ease of full-text search across org-mode files. Text written by other people tends to use different keywords in comparison with my own notes. As a result, my org-mode text searches often yield irrelevant matches - a big problem considering the amount of notes I have in my org files.
For now, I avoid capturing website text directly into org. Instead, I write my own notes about the most important ideas from that website/article. This is also recommended (with providing relevant scientific proofs) in Ahrens (2017) How to Take Smart Notes
Refile
(when init-flagOnce capturing is done and I have some time, the captured notes should be scheduled and moved to the appropriate places (refiled). All the captured tasks are tagged :INBOX: (default tag in inbox.org) and can be viewed in special agenda view. The agenda has 3 groups of tasks: with deadline, scheduled, not scheduled without deadline.
First, I schedule/set deadline for all the tasks, where needed. Secondly, I set the priorities (#A will be always shown focused agenda). Lastly, I refile the tasks into the right projects.
(setq org-refile-use-cache t)
(setq org-refile-targets (quote ((nil :maxlevel . 9)
(org-agenda-files :maxlevel . 9))))
(setq org-refile-use-outline-path 'file
org-outline-path-complete-in-steps nil)
; Allow refile to create parent tasks with confirmation
(setq org-refile-allow-creating-parent-nodes (quote confirm))The most time consuming part of refiling is selecting the right subtree. Yes, I use helm, but it is not enough - there are too many things in my org files. Hence, I limit the refile targets to projects, which are not finished.
Occasionally, I need to add subtask to the existing task, which is not a project.
Change global binding inhelm-map, it does not make sense in place, other than org mode completionEND
(defvar refile-to-tasks nil
"Non nil means, that single tasks will be included into refile candidates.")
(defun yant/toggle-refile-to-tasks ()
"Toggle refiling into single tasks."
(interactive)
(setq refile-to-tasks (not refile-to-tasks))
(setq org-refile-cache nil); reset refile cache
(if refile-to-tasks (message "Refiling to tasks") (message "Not refiling to tasks")))
(bind-key "C-c C-S-w" #'yant/toggle-refile-to-tasks org-mode-map)
(bind-key "C-c C-S-w" #'yant/toggle-refile-to-tasks org-agenda-mode-map)
(use-package helm :config
(bind-key "C-c C-S-w" #'yant/toggle-refile-to-tasks helm-map))
;; (defun yant/verify-refile-target ()
;; "Exclude tasks and todo keywords with a done state from refile targets."
;; (and (not (member "NOREFILE" (org-get-tags (point) 'local)))
;; (not (string-match-p "rss\\.org" (buffer-file-name (buffer-base-buffer))))
;; (or refile-to-tasks
;; (or (member "REFILE" (org-get-tags (point) 'local))
;; (not (bh/is-task-p))))
;; (not (member (nth 2 (org-heading-components)) org-done-keywords))))
(defun yant/verify-refile-target ()
"Exclude tasks and todo keywords with a done state from refile targets."
(let ((next
(yant/org-agenda-skip-org-ql '(and (not (path "rss.org"))
;; (todo)
(not (tags-local "NOREFILE"))
(or refile-to-tasks
(tags-local "REFILE")
(not (task)))))))
(if next (prog1 nil (goto-char next)) t)))
(setq org-refile-target-verify-function 'yant/verify-refile-target)Refile to here
Use helm-org to refile searched heading to point.
(use-package helm-org
:after org
:if init-flag
:straight t
:demand t
:config
(defun helm-org--refile-heading-here (marker)
"Refile selected headings to heading at point.
If multiple candidates are marked in the Helm session, they will
all be refiled. If no headings are marked, the selected heading
will be refiled."
(let* ((victims (with-helm-buffer (helm-marked-candidates)))
(buffer (current-buffer))
(filename (or (buffer-file-name buffer) (buffer-file-name (buffer-base-buffer buffer))))
;; get the heading we refile to so org doesn't
;; output 'Refile to "nil" in file ...'
(heading (org-get-heading :no-tags :no-todo :no-priority :no-comment))
(rfloc (list heading filename nil (point-marker))))
;; Probably best to check that everything returned a value
(when (and victims buffer filename rfloc)
(cl-loop for victim in victims
do (org-with-point-at victim
(org-refile nil nil rfloc))))))
(add-to-list 'helm-org-headings-actions '("Refile heading(s) to heading at point" . helm-org--refile-heading-here) 'append)
)Refiling ideas
Subtrees containing ideas are marked with :TICKLER: tag. Any task refiled to such subtrees is automatically switched to TICKLER state.
(defun yant/mark-ideas-TICKLER-maybe ()
"When a task at point has TICKLER tag, change its todo state to TICKLER."
(when (and (org-at-heading-p)
(member (org-entry-get (point) "TODO") org-not-done-keywords)
(member "TICKLER" (org-get-tags))
(not (member "TICKLER" (org-get-tags nil 'local)))
(not (string= (org-entry-get (point) "TODO") "TICKLER")))
(org-todo "TICKLER")))
(add-hook 'org-after-refile-insert-hook #'yant/mark-ideas-TICKLER-maybe)
__epilogue
)Export
- I do regular export in separate script since it takes a lot of time and hangs Emacs.
- Do not run babel blocks during export
(setq org-export-default-inline-image-rule '(("file" . "\\.\\(gif\\|jp\\(?:e?g\\)\\|p\\(?:bm\\|gm\\|ng\\|pm\\)\\|tiff?\\|x\\(?:[bp]m\\)\\)\\'")))
(setq org-export-use-babel t) (setf (alist-get :eval org-babel-default-header-args) "never-export")
Ignore some headlines in a sense that it will not be exported as \section.
Sometimes, I want to have a headline, but do not want it to be exported as a section, while its text should still be exported.
It is especially useful when writing papers.
I mark such a headlines with :ignore: tag.
The subheadings below such a headlines are promoted up 1 level.
(use-package ox-extra
:config
(ox-extras-activate '(ignore-headlines)))
;; (defun yant/org-export-suppress-some-sections (data backend channel)
;; "Do not put \\section for headlines with :NOSECEXPORT: tag."
;; (let* ((parent (get-text-property (- (string-match "$" data) 2) :parent data))
;; (headline (and parent (cadr parent)))
;; (tags (and headline (plist-get headline :tags))))
;; (when (and (member "NOSECEXPORT" tags)
;; (not (member "SPECIALSECEXPORT" tags)))
;; (replace-regexp-in-string "\\`.*$" "" data))))
;; (add-to-list 'org-export-filter-headline-functions 'yant/org-export-suppress-some-sections)LaTeX (pdf)
(setq org-export-exclude-tags '("NOEXPORT"))
(setq org-latex-pdf-process
(quote
;; ("pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f" "pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f" "pdflatex -shell-escape -interaction nonstopmode -output-directory %o %f" "pdf-compress.sh %b.pdf %b-compressed.pdf && mv -f %b-compressed.pdf %b.pdf")
("latexmk -xelatex -shell-escape -bibtex -f -output-directory=%o %f" "pdf-compress.sh %b.pdf %b-compressed.pdf && mv -f %b-compressed.pdf %b.pdf")
))
(setq org-export-with-timestamps nil)
(setq org-export-in-background nil)Default settings
(setq org-format-latex-header
"
\\documentclass{article}
\\usepackage[usenames]{color}
[PACKAGES]
[DEFAULT-PACKAGES]
\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
\\setlength{\\oddsidemargin}{1.5cm}
\\addtolength{\\oddsidemargin}{-2.54cm}
\\setlength{\\evensidemargin}{\\oddsidemargin}
\\setlength{\\textheight}{\\paperheight}
\\addtolength{\\textheight}{-\\headheight}
\\addtolength{\\textheight}{-\\headsep}
\\addtolength{\\textheight}{-\\footskip}
\\addtolength{\\textheight}{-3cm}
\\setlength{\\topmargin}{1.5cm}
\\addtolength{\\topmargin}{-2.54cm}
")
(setq org-latex-classes
(quote
(("beamer" "\\documentclass[presentation]{beamer}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
("article" "\\documentclass[11pt]{article}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
("report" "\\documentclass[11pt]{report}"
("\\part{%s}" . "\\part*{%s}")
("\\chapter{%s}" . "\\chapter*{%s}")
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
("book" "\\documentclass[11pt]{book}"
("\\part{%s}" . "\\part*{%s}")
("\\chapter{%s}" . "\\chapter*{%s}")
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")))))
(setq org-latex-default-packages-alist
(quote
(("utf8" "inputenc" t)
("a4paper, total={6in, 8in}" "geometry" t)
("" "longtable" nil)
("" "float" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
("" "amsmath" t)
("" "textcomp" t)
("" "marvosym" t)
("" "wasysym" t)
("" "amssymb" t)
("" "hyperref" nil)
("" "graphicx" t)
("" "underscore" t)
("russian" "babel" t)
;; ("UTF8" "ctex" t)
;; ("" "epstopdf" t)
("extendedchars" "grffile" t)
"
% \\epstopdfDeclareGraphicsRule{.tif}{png}{.png}{convert #1 `dirname #1`/`basename #1`.tif`-tif-converted-to.png}
% \\AppendGraphicsExtensions{.tif}
\\usepackage[inline]{enumitem}
\\setlistdepth{10}
"
"\\tolerance=1000"
)))
Beamer
Use metropolis by default
(use-package ox-beamer
:if init-flag
:custom
(org-beamer-theme "[numbering=fraction,block=fill,sectionpage=none]metropolis"))Use my own version of block environment
(use-package ox-beamer
:if init-flag
:custom
(org-beamer-environments-extra
'(("hblock" "h" "\\begin{block}%a{\\vspace*{-3.1ex}}" "\\end{block}"))))Rebind C-c C-b to something else, since I already use it for editing:
(use-package ox-beamer
:if init-flag
:bind (:map org-beamer-mode-map
("C-c '" . org-beamer-select-environment)))html
(setq org-html-inline-image-rules '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\|tif\\)\\'")
("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")))md
(use-package ox-md)Archiving
I usually archive DONE tasks, which were done earlier last month or earlier. They are shown in my GTD self-check agenda view. These are usually small tasks like TODO Contact someone. There is no need to keep them.
In the case if I want to keep the task and notes, I just add :NOARCHIVE: tag to it.
In the past I only archived the tasks, which where done before the past month, but it turned out that there are too many tasks (hundreds). When I was looking through all those tasks, I often missed some tasks I actually wanted too keep, which was sub-optimal. Now, I just consider all the done tasks as available to archive (unless marked with :NOARCHIVE:) and clean them regularly as a part of my Work/Habits/Weekly review.
(defvar prev-query nil)
(defvar prev-buffer nil)
(defvar prev-match-cdr nil)
(define-advice org-agenda (:before (&rest _) reset-skip-cache)
"Reset cache for `yant/org-agenda-skip-org-ql'."
(setq prev-query nil
prev-buffer nil
prev-match-cdr nil))
(advice-add 'org-agenda-get-day-entries :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-deadlines :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-scheduled :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-progress :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-timestamps :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-sexps :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-blocks :before #'org-agenda@reset-skip-cache)
(advice-add 'org-agenda-get-todos :before #'org-agenda@reset-skip-cache)
(defun yant/org-agenda-skip-org-ql (query &optional force)
"Construct skip function using org-ql QUERY.
Do not use cache when FORCE is non-nil."
(require 'org-ql)
(let ((match-list
(if (and (cdr prev-match-cdr)
(equal query prev-query)
(equal prev-buffer (current-buffer))
(not force))
prev-match-cdr
(sort (org-ql-select (list (current-buffer))
query
:narrow t
:action (lambda (&optional el)
(if el
(org-element-property :begin (org-element-lineage el '(headline inlinetask) t))
(org-element-property :begin (org-element-lineage (org-element-at-point) '(headline inlinetask) t)))))
#'<)))
(cur-point (save-excursion
(org-back-to-heading t)
(point))))
(if (not match-list)
(point-max)
(catch :exit
(unless (eq prev-match-cdr match-list)
(setq prev-match-cdr match-list
prev-query query
prev-buffer (current-buffer)))
(while prev-match-cdr
(when (= cur-point (car prev-match-cdr))
(throw :exit nil))
(when (< cur-point (car prev-match-cdr))
(throw :exit (car prev-match-cdr)))
(setq prev-match-cdr (cdr prev-match-cdr)))
(point-max)))))
(defun yant/skip-non-archivable-tasks ()
"Skip trees that are not available for archiving."
(yant/org-agenda-skip-org-ql `(and (done)
(not (todo "FROZEN"))
(not (tags "INBOX"))
(or (not (tags "NOARCHIVE"))
(and (not (tags-local "NOARCHIVE"))
(org-inlinetask-at-task-p))))))
(defun bh/skip-non-archivable-tasks ()
"Skip trees that are not available for archiving."
(save-restriction
(widen)
;; Consider only tasks with done todo headings as archivable candidates
(let* ((next-headline (max
(save-excursion (or (outline-next-heading) (point-max)))
(or (save-excursion (org-agenda-skip-entry-if 'nottodo 'done)) 0)))
(subtree-end (max
(save-excursion (org-end-of-subtree t))
(or (save-excursion (org-agenda-skip-entry-if 'nottodo 'done)) 0)))
(next-item (if (member "ARCHIVEALL" (org-get-tags))
subtree-end ; do not archive subtasks
next-headline)))
(if (or (member "INBOX" (org-get-tags))
(and (member "NOARCHIVE" (org-get-tags))
(not (org-inlinetask-at-task-p))))
subtree-end
(if (and (member (org-get-todo-state) org-done-keywords)
(not (member (org-get-todo-state) '("FROZEN"))))
nil ; available to archive
;; (let* ((daynr (string-to-number (format-time-string "%d" (current-time))))
;; ;; (a-month-ago (* 60 60 24 (+ daynr 1)))
;; ;; (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago))))
;; (this-month (format-time-string "%Y-%m-" (current-time)))
;; (subtree-is-current (save-excursion
;; (forward-line 1)
;; (and (< (point) subtree-end)
;; (re-search-forward this-month subtree-end t)))))
;; (if subtree-is-current
;; next-item ; Has a date in this month or last month, skip it
;; nil)) ; available to archive
next-item)))))Per-year archive files
The default archiving only allow all the task from a single org file to be archived into another single file.
However, after several years, the archive files grew over 10Mb and every time I need to open them for archiving, Emacs hangs for a long time.
Modifying org-archive--compute-location to accept %y keyword for archive year [ credit ]
In addition, %s and %S in org-archive-location now mean file name with extension and file without last extension.
(use-package org-archive
:after org
:config
(setq org-archive-mark-done nil)
(setq org-archive-location "%S_archive_%y.org::datetree/* Archived Tasks")
(defun org-archive--compute-location (location &optional all-archives)
(let* ((current-file (buffer-file-name (buffer-base-buffer)))
(file-non-directory (file-name-nondirectory current-file))
(file-sans-extension (file-name-sans-extension file-non-directory))
(case-fold-search nil))
(setq location (replace-regexp-in-string (regexp-quote "%s") file-non-directory location t)
location (replace-regexp-in-string (regexp-quote "%S") file-sans-extension location t)
location (replace-regexp-in-string (regexp-quote "%y")
(if all-archives
"[0-9]\\{4\\}"
(format-time-string "%Y"))
location t t))
(unless (string-match "::" location) (error "Invalid archive location: %S" location))
(let ((file (substring location 0 (match-beginning 0)))
(heading (substring location (match-end 0))))
(when (and (org-string-nw-p file) all-archives)
(setq file (directory-files default-directory nil file)))
(unless (or (not all-archives) (listp file) (org-string-nw-p file)) (setq file (list current-file)))
(if (listp file)
(mapcar (lambda (f)
(cons (if (org-string-nw-p f) (expand-file-name f) current-file) heading))
file)
(cons (if (org-string-nw-p file) (expand-file-name file) current-file) heading))))))Since the archives are not always contained in a single file, org id and text searches may not know all the archive files. Hence, I set more files in org-agenda-text-search-extra-files in addition to default ‘agenda-archives.
(use-package org-id
:after org
:custom
(org-id-extra-files 'org-agenda-text-search-extra-files)
:config
(use-package org-archive
:config
(defun org-all-archive-files ()
"List of all archive files used in the current buffer."
(let* ((case-fold-search t)
(files (mapcar #'car (org-archive--compute-location org-archive-location t))))
(org-with-point-at 1
(while (re-search-forward "^[ \t]*:ARCHIVE:" nil t)
(when (org-at-property-p)
(pcase (org-archive--compute-location (match-string 3))
(`(,file . ,_)
(when (org-string-nw-p file)
(cl-pushnew file files :test #'file-equal-p))))))
(cl-remove-if-not #'file-exists-p (nreverse files)))))
)
)Archive inline tasks
Inline tasks cannot be archived for now ([2017-12-29 Fri]), so, I override standard archiving function to make it possible to archive them (into separate location org-inlinetask-archive-location)
(defvar org-inlinetask-archive-location "%S_archive_%y.org::datetree/* Archived Inline Tasks"
"Where to archive inline tasks.")
(defvar org-inlinetask-max-level 100
"Maximum level for inline task to be archived.")
(define-advice org-archive-subtree (:around (oldfunc &rest args) org-archive-inline-task)
"Archive inline tasks according to `org-inlinetask-archive-location'."
(if (boundp 'org-inlinetask-min-level)
(let* ((org-inlinetask-min-level-real org-inlinetask-min-level)
(at-inline-task (save-match-data (org-inlinetask-in-task-p)))
(org-inlinetask-min-level (if at-inline-task
org-inlinetask-max-level
org-inlinetask-min-level))
(org-archive-location (if at-inline-task
org-inlinetask-archive-location
org-archive-location))
(org-archived-inlinetask-point (point)))
(apply oldfunc args))
(apply oldfunc args)))
;; It is needed to cut inlinetask properly (remove trailing "***... END")
(add-hook 'org-archive-hook (lambda () (when (boundp 'org-inlinetask-min-level-real)
(setq org-inlinetask-min-level org-inlinetask-min-level-real))))
(define-advice org-archive-subtree (:after (&rest args) org-archive-inline-task-keep-point)
"Keep the point after archiving inline task."
(when (boundp 'org-archived-inlinetask-point)
(goto-char org-archived-inlinetask-point)))Sometimes, I have a small projects, where I do not want to decide whether I want to archive every single subtask or not. I tag them :ARCHIVEALL:.
Thanks God, I do not need to open my archive file frequently - my TODO.org_archive is >3Mb and takes forever to open. I am not sure if I need to do something with it.
- State “TODO” from “HOLD” [2019-05-16 Thu 11:30]
- State “HOLD” from “TODO” [2017-12-22 Fri 22:01]
Consider it if it becomes annoying
Trash attachments of archived tasks
If a task being archived contains attachments, it is better to delete them. Otherwise, I’d rather keep the task in place to avoid hanging files.
also show the attachment list when askingEND(setq org-attach-archive-delete 'query)
;; redefining to show the list of attachments in the query
(defun org-attach-archive-delete-maybe ()
"Maybe delete subtree attachments when archiving.
This function is called by `org-archive-hook'. The option
`org-attach-archive-delete' controls its behavior."
(org-with-point-at-org-buffer
(when (org-at-heading-p)
(org-back-to-heading t)
(let ((limit (save-excursion (org-end-of-subtree t) (point))))
(while (re-search-forward org-attach-auto-tag limit t)
(when (and (org-at-heading-p) (member org-attach-auto-tag (org-get-tags nil t)));; do not ask if no attachments
(let ((heading (org-get-heading nil nil 'norpiority 'nocomment)))
(when (if (eq org-attach-archive-delete 'query)
(let* ((dired-buf (cl-letf (((symbol-function 'dired) (lambda (dir)
(interactive)
(dired-noselect dir nil) )))
(org-attach-reveal-in-emacs))))
(save-window-excursion
(dired-pop-to-buffer dired-buf)
(revert-buffer)
(select-window (old-selected-window))
(prog1
(yes-or-no-p (format "%s: Delete all attachments? "
heading))
(kill-buffer dired-buf))))
org-attach-archive-delete)
(org-attach-delete-all t)))))))))Move attachments of tasks with ARCHIVE tag to backup folder
If the archiving is done just with ARCHIVE tag, suggest to move the attachments to archive instead.
(defvar yant/org-archive-archive-path "/mnt/Backup/Archive/"
"Path to system archive location.")
(defun org-archive-move-maybe (&optional unarchive)
"Maybe move subtree attachments to Archive folder when archiving.
Unarchive when UNARCHIVE is non-nil."
(org-with-point-at-org-buffer
(when (org-at-heading-p)
(let ((limit (save-excursion (org-end-of-subtree)))
(parent-dir ""))
(while (re-search-forward org-attach-auto-tag limit t)
(when (and (org-at-heading-p) (member org-attach-auto-tag (org-get-tags nil t))) ;; do not ask if no attachments
;; If archive dir is not in `yant/org-archive-archive-path', we did not really archive anything.
(unless (and unarchive (not (string-prefix-p yant/org-archive-archive-path (org-attach-dir))))
;; Do not try to un/archive multiple times for inherited dirs.
(unless (string= parent-dir (org-attach-dir))
(setq parent-dir (org-attach-dir))
(let ((heading (org-get-heading nil nil 'norpiority 'nocomment)))
(when (let* ((dired-buf (cl-letf (((symbol-function 'dired) (lambda (dir)
(interactive)
(dired-noselect dir nil) )))
(org-attach-reveal-in-emacs))))
(save-window-excursion
(dired-pop-to-buffer dired-buf)
(select-window (old-selected-window))
(prog1
(yes-or-no-p (format "%s: %s all attachments? "
heading
(if unarchive
"Unarchive"
"Archive")))
(kill-buffer dired-buf))))
(while (not (file-exists-p yant/org-archive-archive-path))
(unless (yes-or-no-p (format "Archive location %s does not exist. Try again? " yant/org-archive-archive-path))
(user-error "Archive location not present.")))
(when-let ((old-dir (org-attach-dir))
(new-dir (if (not unarchive)
(let ((org-attach-id-dir yant/org-archive-archive-path))
(org-attach-dir 'create))
(org-delete-property "DIR")
(org-attach-dir t))))
(let ((attachments (directory-files old-dir 'full "^[^.]+")))
(mapc (lambda (file)
(copy-file file (format "%s/%s" new-dir (file-name-nondirectory file)) nil t t t))
attachments)
;; Delete after successful copy only for safety.
(mapc #'delete-file attachments)
(delete-directory old-dir)
(if (not unarchive)
(org-set-property "DIR" new-dir)
(org-delete-property "DIR"))))))))))))))
(define-advice org-toggle-archive-tag (:before (&rest _) archive-attachments)
"Move attachments to/from archive directory."
(org-archive-move-maybe (member org-archive-tag (org-get-tags))))Warn when archiving subtree with children
(use-package org-archive
:if init-flag
:after org
:config
(define-advice org-archive-subtree (:around (oldfun &optional find-done) query-subtree-with-children)
"Ask about archiving subtrees with children"
(interactive "P")
(let ((has-children (and (org-at-heading-p)
(save-excursion
(let ((end-of-subtree (save-excursion (and (org-end-of-subtree t) (point)))))
(beginning-of-line 2)
(unless (> (point) end-of-subtree)
(org-with-limited-levels
(re-search-forward org-outline-regexp-bol end-of-subtree t)))))))
(headline (org-get-heading)))
(when (or (not has-children)
(yes-or-no-p (format "%s: There are child headings. Really archive?" headline)))
(funcall-interactively oldfun find-done)))))Babel
Babel is a great way to combine source code and text.
The source code editing is usually done in a new buffer. However, I do not like the default binding C-c C-'=. I use =C-c C-b instead.
(when init-flag
(bind-key "C-c C-b" 'org-edit-special org-mode-map)
(bind-key "C-c C-b" 'org-edit-src-exit org-src-mode-map)
(use-package poly-org
:defer t
:after polymode
:config
(defun poly-org-edit-special ()
"Run `org-edit-special' from poly-org."
(interactive)
(polymode-with-current-base-buffer #'funcall-interactively #'org-edit-special))
(bind-key "C-c C-b" #'polymode-toggle-chunk-narrowing poly-org-mode-map)))For convenience, add header-args property to completion
(add-to-list 'org-default-properties "header-args")Structure templates
I can just type <el<TAB> to enter elisp code block.
It can be done using org-tempo.
(use-package org-tempo
:after org
:if init-flag
:init
(push (cons "el" "src emacs-lisp") org-structure-template-alist))Source block editing functions from scimax
(when init-flag
(meta-defun meta-split :mode org-mode :cond (org-in-src-block-p) scimax-split-src-block)
(bind-keys :map boon-command-map
("S" . meta-split)
("Z" . scimax-insert-src-block)))
;; from https://github.com/jkitchin/scimax/blob/master/scimax-ob.el
(defun scimax-insert-src-block (&optional below)
"Insert a src block above the current point.
With prefix arg BELOW, insert it below the current point.
If point is in a block, copy the header to the new block"
(interactive "P")
(if (org-in-src-block-p)
(let* ((src (org-element-context))
(start (org-element-property :begin src))
(end (org-element-property :end src))
(lang (org-element-property :language src))
(switches (or (org-element-property :switches src) ""))
(parameters (or (org-element-property :parameters src) ""))
location)
(if below
(progn
(goto-char start)
(setq location (org-babel-where-is-src-block-result nil nil))
(if (not location)
(goto-char end)
(goto-char location)
(goto-char (org-element-property :end (org-element-context))))
(insert (format "\n#+BEGIN_SRC %s %s %s
#+END_SRC\n\n" lang switches parameters))
(forward-line -3))
;; after current block
(goto-char (org-element-property :begin (org-element-context)))
(insert (format "\n#+BEGIN_SRC %s %s %s
#+END_SRC\n\n" lang switches parameters))
(forward-line -3)))
;; Not in a src block, just insert a block
(beginning-of-line)
(insert (format "\n#+BEGIN_SRC %s
#+END_SRC\n" (completing-read "Language: " (mapcar 'car org-babel-load-languages))))
(forward-line -1)))
(defun scimax-split-src-block (&optional above)
"Split the current src block with point in between the blocks."
(interactive "P")
(let* ((el (org-element-context))
(p (point))
(language (org-element-property :language el))
(switches (org-element-property :switches el))
(parameters (org-element-property :parameters el)))
(beginning-of-line)
(insert (format "#+END_SRC
#+BEGIN_SRC %s %s %s\n" language (or switches "") (or parameters "")))
(forward-line -1)
(insert "\n")
(forward-line -1)))Backends
(setq org-ditaa-jar-path "~/.emacs.d/site-lisp/ditaa.jar")
(use-package ob-mathematica
:init
(setq org-babel-mathematica-command "wolfram -script"))
(org-babel-do-load-languages 'org-babel-load-languages
'(
(shell .t)
(emacs-lisp . t)
(org . t)
(perl . t)
(python .t)
(C . t)
(ditaa . t)
(gnuplot . t)
(calc . t)
(dot . t)
(latex . t)
;;(mathematica . t)
))
(use-package wolfram-mode
:if init-flag
:defer t
:init
(add-to-list 'org-src-lang-modes '("mathematica" . "wolfram")))Default arguments
Nowebis useful, I’d rather enable it everywhere than set it every time to run the code
(setq org-babel-default-header-args '((:session . "none")
(:results . "replace")
(:exports . "code")
(:cache . "no")
(:noweb . "yes")
(:hlines . "no")
(:tangle . "no")
(:comments . "link")
(:eval . "never-export")))
(setq org-babel-default-header-args:shell '((:results . "output")))- Show stderr in the shell output (Source)
(setq org-babel-default-header-args:sh
'((:prologue . "exec 2>&1") (:epilogue . ":"))
)Evaluation
- State “TODO” from [2018-07-11 Wed 09:19]
(setq org-confirm-babel-evaluate nil)I hate when org is cluttering org file directory with generated files (:file). It is better to save everything inside hidden entry’s attachment folder instead. I just redefine default-directory before
org-babel-execute-src-block, so that :dir or :output-dir can be still set if needed.
(define-advice org-babel-execute-src-block (:filter-args (&optional args) set-detault-dir-to-org-attach-path)
"Set working directory to the current entry's attach directory."
(if (and (eq major-mode 'org-mode)
(buffer-file-name))
(let* ((directory (file-name-as-directory (org-attach-dir 'create-if-none)))
(arg (car args))
(info (cadr args))
(params (org-babel-merge-params (nth 2 info) (caddr args)))
(dir-param (alist-get :dir params)))
(unless (and dir-param (or (equal (f-full default-directory) (f-full dir-param))
(f-absolute-p dir-param)))
(setf (alist-get :dir params)
(if dir-param
(f-join directory (alist-get :dir params))
directory)))
(list arg info params))
args))
;; (advice-remove 'org-babel-execute-src-block #'org-babel-execute-src-block@set-detault-dir-to-org-attach-path)Allow passing file: links as variables to src blocks
(defun org-expand-link (link-string)
"Convert file LINK-STRING to file path."
(setq link-string (org-link-expand-abbrev link-string))
(unless (string-match-p org-bracket-link-regexp link-string)
(setq link-string (s-concat "[[" link-string "]]")))
(let ((link
(with-temp-buffer
(let ((org-inhibit-startup nil))
(insert link-string)
(org-mode)
(goto-char (point-min))
(org-element-link-parser)))))
(pcase (org-element-type link)
('link
(org-element-property :path link))
(_ link-string))))Library of babel function definition:
(org-expand-link link)Also, it make sense to show inline images, which I frequently generate via Gnuplot after the evaluation
(add-hook! 'org-babel-after-execute-hook
(unless (eq this-command 'org-babel-tangle)
(org-display-inline-images nil nil
(save-excursion (org-back-to-heading-or-point-min t))
(save-excursion (or (outline-next-heading) (point-max))))))Gnuplot
I had to modify org-babel-expand-body:gnuplot to make it respect :dir property.
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
(out-file (cdr (assq :file params)))
(prologue (cdr (assq :prologue params)))
(epilogue (cdr (assq :epilogue params)))
(term (or (cdr (assq :term params))
(when out-file
(let ((ext (file-name-extension out-file)))
(or (cdr (assoc (intern (downcase ext))
*org-babel-gnuplot-terms*))
ext)))))
(title (cdr (assq :title params)))
(lines (cdr (assq :line params)))
(sets (cdr (assq :set params)))
(x-labels (cdr (assq :xlabels params)))
(y-labels (cdr (assq :ylabels params)))
(timefmt (cdr (assq :timefmt params)))
(time-ind (or (cdr (assq :timeind params))
(when timefmt 1)))
(directory (or (alist-get :dir params)
default-directory))
(add-to-body (lambda (text) (setq body (concat text "\n" body)))))
;; append header argument settings to body
(when title (funcall add-to-body (format "set title '%s'" title)))
(when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
(funcall add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d"
(cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(funcall add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d"
(cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(funcall add-to-body "set xdata time")
(funcall add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
(when out-file
;; set the terminal at the top of the block
(funcall add-to-body (format "set output \"%s\"" out-file))
;; and close the terminal at the bottom of the block
(setq body (concat body "\nset output\n")))
(when term (funcall add-to-body (format "set term %s" term)))
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
(funcall add-to-body
(mapconcat #'identity
(org-babel-variable-assignments:gnuplot params)
"\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
vars)
(when prologue (funcall add-to-body prologue))
(when epilogue (setq body (concat body "\n" epilogue)))
;; Setting the directory needs to be done first so that
;; subsequent 'output' directive goes to the right place.
(when directory (funcall add-to-body (format "cd '%s'" directory))))
body))Async evaluation
(use-package ob-async
:straight t
)Tangle
I have a lot of small scripts and programs written at some point for some purpose I do not remember anymore. Hence, I prefer to use org files instead of all kinds of script files in the system. There are few things, which I need to make it work comfortably:
- make sure that the script are tangled when I save org file, because it is easy to forget tangling of some files after editing.
Asynchronous tangling
(defvar yant/org-babel-tangle-async-process-waiting-p nil)
(defvar yant/org-babel-tangle-async-process-running-p nil)
(defun yant/org-babel-tangle-async (file &optional target-file lang)
"Invoke `org-babel-tangle-file' asynchronously."
(unless yant/org-babel-tangle-async-process-waiting-p ;; Tangling queued already.
(setq yant/org-babel-tangle-async-process-waiting-p t) ;; We may be blocked ahead. Notify that there is waiting thread.
;; Wait until running tangling process finishes.
(while yant/org-babel-tangle-async-process-running-p (sit-for 5))
(setq yant/org-babel-tangle-async-process-waiting-p nil)
(require 'async)
(message "Tangling %s..." (buffer-file-name))
(setq yant/org-babel-tangle-async-process-running-p t) ; Note that we a running.
(async-start
(let ((args (list file target-file lang)))
`(lambda ()
(setq org-tangle-flag t)
(ignore-errors
(load "~/.emacs.d/config.el"))
(setq org-confirm-babel-evaluate nil)
(require 'org)
(require 'org-attach)
(require 'ob-shell)
(let ((start-time (current-time)))
(org-with-wide-buffer
(apply #'org-babel-tangle-file ',args))
(list (float-time (time-since start-time))))))
(let ((message-string (format "Tangling (%S %S %S) completed in " file target-file lang)))
`(lambda (tangle-time)
;; We are done. Unblock.
(setq yant/org-babel-tangle-async-process-running-p nil)
(message (concat ,message-string
(format "%s seconds" tangle-time))))))))
(defvar yant/auto-tangle-list nil
"List of files, which can be safely tangled on save.
The list is saved between Emacs sessions.")
(when init-flag
(use-package savehist
:config
(add-to-list 'savehist-additional-variables 'yant/auto-tangle-list))
(savehist-mode +1)
(defun yant/toggle-buffer-auto-tangle (arg)
"Toggle auto tangling of a buffer."
(interactive "P")
(if (not (eq major-mode 'org-mode))
(message "Org-mode is not active in buffer \"%s\"" (buffer-name))
(cond ((not arg)
(if (member (buffer-file-name) yant/auto-tangle-list)
(progn (setq yant/auto-tangle-list (delete (buffer-file-name) yant/auto-tangle-list))
(message "Auto tangling disabled for %s" (buffer-file-name)))
(add-to-list 'yant/auto-tangle-list (buffer-file-name))
(message "Auto tangling enabled for %s" (buffer-file-name))))
((or (and (not (listp arg)) (> arg 0))
(equal arg '(4)))
(add-to-list 'yant/auto-tangle-list (buffer-file-name))
(message "Auto tangling enabled for %s" (buffer-file-name)))
(t
(setq yant/auto-tangle-list (delete (buffer-file-name) yant/auto-tangle-list))
(message "Auto tangling disabled for %s" (buffer-file-name))))))
(bind-key "C-c C-*" #'yant/toggle-buffer-auto-tangle org-mode-map))
(defun yant/org-babel-tangle-current-buffer-async ()
"Tangle current buffer asynchronously."
(when (and (eq major-mode 'org-mode)
(member (buffer-file-name) yant/auto-tangle-list))
(make-thread (lambda () (yant/org-babel-tangle-async (buffer-file-name))) "Async tangling")))
(add-hook 'after-save-hook #'yant/org-babel-tangle-current-buffer-async)Export
Frequently, I run heavy analytical code as a part of my project. I it totally inconvenient to run these hour longing codes during export. Hence, I disable babel evaluation on export by default.Library of babel
https://kdr2.com/tech/emacs/1805-approach-org-ref-code-to-text.html
In addition to lisp code in init.el, it is also possible to define globally available babel functions defined, for example. in this file
(use-package org
:defer t
:hook (org-load . yant/org-babel-ingest-my-files)
:config
(defun yant/org-babel-ingest-my-files ()
"Load default babel library files."
(org-babel-lob-ingest
(expand-file-name "~/.emacs.d/config.org"))))(let* ((named-element (org-element-map (org-element-parse-buffer) org-element-all-elements
(lambda (element)
(when (string= (org-element-property :name element) name)
element))
nil t))
(result (buffer-substring (org-element-property :contents-begin named-element)
(org-element-property :contents-end named-element))))
(format "\"%s\"" (replace-regexp-in-string "\\\"" "\\\\\"" result))) ;; escape quotePreview
(when init-flagPreview images and latex formulas.
(setq org-image-actual-width '(600))
(setq org-latex-create-formula-image-program 'imagemagick)
(setq org-format-latex-options
(quote
(:foreground default :background default :scale 2.0 :justify center :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 :matchers
("begin" "$1" "$" "$$" "\\(" "\\["))));; 2x height of formulas
(setq org-latex-inline-image-rules
(quote
(("file" . "\\.\\(jpeg\\|jpg\\|png\\|eps\\|tikz\\|pgf\\|svg\\|bmp\\|tif\\)\\'"))))Toggle preview of an image at point (by C-c C-c or TAB).
This is especially useful in large buffers where processing all the images by org-toggle-inline-images takes too much time.
Inspired by https://www.reddit.com/r/orgmode/comments/f8qngz/toggle_only_current_inline_image_with_tab/
[2020-11-30 Mon] If the image is a multi-frame (like gif), also toggle animation.
(use-package org
:defer t
:config
(defun org-toggle-inline-images-at-point ()
(when-let* ((link-region (org-in-regexp org-link-bracket-re 1)))
(let ((org-inline-image-overlays-old org-inline-image-overlays))
(save-restriction
(narrow-to-region (car link-region) (cdr link-region))
(if (-intersection (overlays-at (point)) org-inline-image-overlays)
(mapc (lambda (ov)
(when (member ov org-inline-image-overlays)
(if (or (not (image-multi-frame-p (overlay-get ov 'display)))
(overlay-get ov 'animation-in-progress))
(progn
;; Flush image from cache and stop the timers
(cancel-function-timers #'image-animate-timeout)
;; (image-flush (overlay-get ov 'display) t)
(delete-overlay ov)
(setq org-inline-image-overlays (delete ov org-inline-image-overlays)))
(overlay-put ov 'animation-in-progress t)
;; Putting 100 sec. Otherwise, may lag too much.
(image-animate (overlay-get ov 'display) nil 100))))
(overlays-at (point)))
(org-display-inline-images 'include-linked 'refresh))
)
(unless (equal org-inline-image-overlays org-inline-image-overlays-old) t)) ;; if overlays did not change, the link is not inline image
))
(add-hook 'org-tab-first-hook #'org-toggle-inline-images-at-point)
(add-hook 'org-ctrl-c-ctrl-c-hook #'org-toggle-inline-images-at-point))Use the same binding to preview LaTeX
(use-package org
:if init-flag
:config
(defun yant/org-toggle-latex-fragment-at-point-maybe ()
"Toggle latex fragment at point or return nil if no fragment is at point."
(when (and (eq major-mode 'org-mode)
(eq (org-element-type (org-element-context)) 'latex-fragment))
(org-toggle-latex-fragment)))
(add-hook 'org-tab-first-hook #'org-toggle-inline-images-at-point)
(add-hook 'org-ctrl-c-ctrl-c-hook #'yant/org-toggle-latex-fragment-at-point-maybe))Justify and number the formulas
;; from https://github.com/jkitchin/scimax/blob/master/scimax-org.el
(use-package ov
:straight t
:config
(defun org-latex-fragment-justify (justification)
"Justify the latex fragment at point with JUSTIFICATION.
JUSTIFICATION is a symbol for 'left, 'center or 'right."
(interactive
(list (intern-soft
(completing-read "Justification (left): " '(left center right)
nil t nil nil 'left))))
(let* ((ov (ov-at))
(beg (ov-beg ov))
(end (ov-end ov))
(shift (- beg (line-beginning-position)))
(img (overlay-get ov 'display))
(img (and (and img (consp img) (eq (car img) 'image)
(image-type-available-p (plist-get (cdr img) :type)))
img))
space-left offset)
(when (and img
;; This means the equation is at the start of the line
(= beg (line-beginning-position))
(or
(string= "" (s-trim (buffer-substring end (line-end-position))))
(eq 'latex-environment (car (org-element-context)))))
(setq space-left (- (window-max-chars-per-line) (car (image-size img)))
offset (floor (cond
((eq justification 'center)
(- (/ space-left 2) shift))
((eq justification 'right)
(- space-left shift))
(t
0))))
(when (>= offset 0)
(overlay-put ov 'before-string (make-string offset ?\ ))))))
(defun org-latex-fragment-justify-advice (beg end image imagetype)
"After advice function to justify fragments."
(org-latex-fragment-justify (or (plist-get org-format-latex-options :justify) 'left)))
(advice-add 'org--format-latex-make-overlay :after 'org-latex-fragment-justify-advice)
;; ** numbering latex equations
;; Numbered equations all have (1) as the number for fragments with vanilla
;; org-mode. This code injects the correct numbers into the previews so they
;; look good.
(defun org-renumber-environment (orig-func &rest args)
"A function to inject numbers in LaTeX fragment previews."
(let ((results '())
(counter -1)
(numberp))
(setq results (cl-loop for (begin . env) in
(org-element-map (org-element-parse-buffer) 'latex-environment
(lambda (env)
(cons
(org-element-property :begin env)
(org-element-property :value env))))
collect
(cond
((and (string-match "\\\\begin{equation}" env)
(not (string-match "\\\\tag{" env)))
(cl-incf counter)
(cons begin counter))
((string-match "\\\\begin{align}" env)
(prog2
(cl-incf counter)
(cons begin counter)
(with-temp-buffer
(insert env)
(goto-char (point-min))
;; \\ is used for a new line. Each one leads to a number
(cl-incf counter (count-matches "\\\\$"))
;; unless there are nonumbers.
(goto-char (point-min))
(cl-decf counter (count-matches "\\nonumber")))))
(t
(cons begin nil)))))
(when (setq numberp (cdr (assoc (point) results)))
(setf (car args)
(concat
(format "\\setcounter{equation}{%s}\n" numberp)
(car args)))))
(apply orig-func args))
(advice-add 'org-create-formula-image :around #'org-renumber-environment)
(defun org-inject-latex-fragment (orig-func &rest args)
"Advice function to inject latex code before and/or after the equation in a latex fragment.
You can use this to set \\mathversion{bold} for example to make it bolder."
(setf (car args)
(concat
(or (plist-get org-format-latex-options :latex-fragment-pre-body) "")
(car args)
(or (plist-get org-format-latex-options :latex-fragment-post-body) "")))
(apply orig-func args))
(advice-add 'org-create-formula-image :around #'org-inject-latex-fragment )
)__epilogue
)Transclusion
Sometimes, org-mode items belong to multiple places at the same time. Link can help for this matter, but they are not ideal.
For example, take a TODO headline of a research article that should be read and analysed. The same article might belong to multiple projects and should be “done” in different ways depending on the project context. For one project, the article might be useless, while it can be critical for another project. On the other hand, duplicating TODO item does not sound very useful since most of the information about the article needs to be duplicated. Moreover, changes to that information are hard to keep track of when the same text exists in multiple places.
The solution to this is so-called “transclusion” when the same text/headlines are sheared between different places in a document or even in different files.
Appearance
Lighter
Org-capture mode lighter
(use-package org-capture
:if init-flag
:config
(diminish 'org-capture-mode (s-concat " "
(propertize (all-the-icons-material "note_add"
:v-adjust 0.04)
'face `(( :family "Material Icons"
:foreground "red"
:height 1.4))))))Org src mode lighter
(use-package org-src
:if init-flag
:after org
:config
(diminish 'org-src-mode (s-concat " "
(propertize (all-the-icons-material "code" :v-adjust 0.04)
'face `((
:family "Material Icons"
:height 1.2))
;; 'display '(raise -0.2)
)
"org")))Text
Add some extra rendering for LaTeX:
(add-to-list 'org-entities-user '("angstrom" "\\AA" nil "&Å;" "A" "A" "Å"))Line truncation:
(use-package org
:if init-flag
:config
(add-hook! 'org-mode-hook (let ((inhibit-message t))
(toggle-truncate-lines -1)
(visual-line-mode +1))))Do not use box around checkbox items
(use-package org-faces
:config
(set-face-attribute 'org-checkbox nil
:box nil
:background (face-background 'default))
)Verbatim text font
(use-package org-faces
:if init-flag
:custom-face
(org-verbatim ((t (:height 0.95 :weight semi-light)))))Links
Show broken links to files
(org-link-set-parameters
"file"
:face (lambda (path) (if (file-exists-p (org-link-unescape path)) 'org-link 'org-warning)))Use posframe to offer link selection
#org_open_at_point [2020-10-14 Wed] Add smarted duplicate removal:link means the same as [[link]]
(use-package posframe
:if init-flag
:straight t
:after el-patch
:config
(el-patch-feature org)
(el-patch-defun org-offer-links-in-entry (buffer marker &optional nth zero)
"Offer links in the current entry and return the selected link.
If there is only one link, return it.
If NTH is an integer, return the NTH link found.
If ZERO is a string, check also this string for a link, and if
there is one, return it."
(with-current-buffer buffer
(org-with-wide-buffer
(goto-char marker)
(let ((cnt ?0)
have-zero end links link c)
(when (and (stringp zero) (string-match org-link-bracket-re zero))
(push ((el-patch-swap match-string match-string-no-properties) 0 zero) links)
(setq cnt (1- cnt) have-zero t))
(save-excursion
(org-back-to-heading t)
(setq end (save-excursion (outline-next-heading) (point)))
(while (re-search-forward org-link-any-re end t)
(unless (save-match-data (eq 'src-block (org-element-type (org-element-at-point))))
(push ((el-patch-swap match-string match-string-no-properties) 0) links)))
;; (el-patch-add
;; (setq links
;; (mapcar (lambda (link)
;; (if (string-match-p "^\\[\\[" link)
;; link
;; (format "[[%s]]" link)))
;; links)))
(setq links (org-uniquify (reverse links))))
(el-patch-add
(when-let ((attach-dir (org-attach-dir)))
(unless (directory-empty-p attach-dir)
(push "[[elisp:(org-attach-open)][Open attachment]]" links))))
(cond
((null links)
(message "No links"))
((equal (length links) 1)
(setq link (car links)))
((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
(setq link (nth (if have-zero nth (1- nth)) links)))
(t ; we have to select a link
(save-excursion
(save-window-excursion
(el-patch-remove (delete-other-windows))
((el-patch-swap with-output-to-temp-buffer with-current-buffer) (el-patch-swap "*Select Link*" (get-buffer-create "*Select Link*"))
(el-patch-add (erase-buffer))
(el-patch-add (insert "Select link to open, RET to open all:\n"))
(dolist (l links)
(cond
((not (string-match org-link-bracket-re l))
((el-patch-swap princ insert) (format "[%c] %s\n" (cl-incf cnt)
(org-unbracket-string "<" ">" l))))
((match-end 2)
((el-patch-swap princ insert) (format "[%c] %s (%s)\n" (cl-incf cnt)
(match-string 2 l) (match-string 1 l))))
(t ((el-patch-swap princ insert) (format "[%c] %s\n" (cl-incf cnt)
(match-string 1 l)))))))
(el-patch-wrap 1 0
(unwind-protect
(el-patch-wrap 1 0
(progn
(el-patch-swap
(org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
(posframe-show (get-buffer "*Select Link*")
:poshandler 'posframe-poshandler-frame-center
:foreground-color (face-foreground 'mode-line)
:background-color (face-background 'highlight)
:internal-border-width 20
))
(message "Select link to open, RET to open all:")
(setq c (read-char-exclusive))))
(and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))))
(when (equal c ?q) (user-error "Abort"))
(if (equal c ?\C-m)
(setq link links)
(setq nth (- c ?0))
(when have-zero (setq nth (1+ nth)))
(unless (and (integerp nth) (>= (length links) nth))
(user-error "Invalid link selection"))
(setq link (nth (1- nth) links)))))
(when (string= link "[[elisp:(org-attach-open)][Open attachment]]")
(setq link nil))
(cons link end))))))Items
I do not want bigger items font because I tend to use items a lot(custom-set-faces
'(org-level-1 ((t (:inherit outline-1 :height 1.0))))
'(org-level-2 ((t (:inherit outline-2 :height 1.0))))
'(org-level-3 ((t (:inherit outline-3 :height 1.0))))
'(org-level-4 ((t (:inherit outline-4 :height 1.0))))
'(org-level-5 ((t (:inherit outline-5 :height 1.0))))
)
Utilise pretty-symbols to show bullets, priorities, and keywords. It is much faster than overlay-based org-bullets.
#pretty_symbols
(use-package pretty-symbols
:config
(require 'org-inlinetask)
(setq pretty-symbol-patterns
(append pretty-symbol-patterns
`(;;(?▤ org-specific ":LOGBOOK:" (org-mode))
;;(?⚙ org-specific ":PROPERTIES:" (org-mode))
;;(?⏏ org-specific ":END:" (org-mode))
(?— org-specific "\\b---\\b" (org-mode))
;; (?★ org-specific "\\[#A\\]" (org-mode))
(?🅰 org-specific "\\[#A\\]" (org-mode))
(?🄲 org-specific "\\[#C\\]" (org-mode))
(?■ org-specific "\\(^\\*\\)[^*]" (org-mode) 1)
(?• org-specific "^\\(?:\\*\\{1\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⊢ org-specific "^\\(?:\\*\\{2\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋮ org-specific "^\\(?:\\*\\{3\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋱ org-specific "^\\(?:\\*\\{4\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋮ org-specific "^\\(?:\\*\\{5\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋱ org-specific "^\\(?:\\*\\{6\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋮ org-specific "^\\(?:\\*\\{7\\}\\)\\(\\*\\)[^*]" (org-mode) 1)
(?⋱ org-specific ,(format "^\\(?:\\*\\{8,%d\\}\\)\\(\\*\\)[^*]" (- org-inlinetask-min-level 2)) (org-mode) 1)
((yant/str-to-glyph " ") org-specific ,(format "^\\(\\*\\{%d,%d\\}\\)\\*[^*]" (1- org-inlinetask-min-level) (1- org-inlinetask-max-level)) (org-mode) 1)
((yant/str-to-glyph "⇒⇒⇒") org-specific ,(format "^\\(\\*\\{%d,%d\\}\\)\\(\\*\\)[^*]" (1- org-inlinetask-min-level) (1- org-inlinetask-max-level)) (org-mode) 2)
(?╭ org-specific "^[ ]*\\(#[+]NAME\\)" (org-mode) 1)
(?╭ org-specific "^[ ]*\\(#[+]name\\)" (org-mode) 1)
(?├ org-specific "[ ]*\\(#[+]begin_src\\)" (org-mode) 1)
(?├ org-specific "[ ]*\\(#[+]BEGIN_SRC\\)" (org-mode) 1)
(?╰ org-specific "[ ]*\\(#[+]end_src\\)" (org-mode) 1)
(?╰ org-specific "[ ]*\\(#[+]END_SRC\\)" (org-mode) 1)
(?╞ org-specific "[ ]*\\(#[+]TBLFM\\)" (org-mode) 1)
(?🗣 org-specific "[ ]*\\(#[+]begin_quote\\)" (org-mode) 1)
(?🗣 org-specific "[ ]*\\(#[+]end_quote\\)" (org-mode) 1)
(?🗣 org-specific "[ ]*\\(#[+]BEGIN_QUOTE\\)" (org-mode) 1)
(?🗣 org-specific "[ ]*\\(#[+]END_QUOTE\\)" (org-mode) 1)
(?💡 org-specific "[ ]*\\(#[+]begin_example\\)" (org-mode) 1)
(?💡 org-specific "[ ]*\\(#[+]end_example\\)" (org-mode) 1)
(?💡 org-specific "[ ]*\\(#[+]BEGIN_EXAMPLE\\)" (org-mode) 1)
(?💡 org-specific "[ ]*\\(#[+]END_EXAMPLE\\)" (org-mode) 1)
(?⏎ org-specific "[ ]*\\(#[+]RESULTS\\)" (org-mode) 1)
(?⫘ org-specific "[ ]*\\(#[+]SETUPFILE\\)" (org-mode) 1)
(?👨 org-specific "[ ]*\\(#[+]AUTHOR\\)" (org-mode) 1)
(?🖂 org-specific "[ ]*\\(#[+]EMAIL\\)" (org-mode) 1)
(?⚙ org-specific "[ ]*\\(#[+]PROPERTY\\)" (org-mode) 1)
(?⏣ org-specific "[ ]*\\(#[+]OPTIONS\\)" (org-mode) 1)
(?🔗 org-specific ":\\(BOOKMARK\\):" (org-mode) 1)
(?🖬 org-specific ":\\(ARCHIVED\\):" (org-mode) 1)
((yant/str-to-glyph "📁📁📁") org-specific ":\\(ATTACH\\):" (org-mode) 1)
(?⚒ org-specific ":\\(PhD\\):" (org-mode) 1)
;; (?🖳 org-specific ":\\(PhD\\):" (org-mode) 1)
(?🏠 org-specific ":\\(COMMON\\):" (org-mode) 1)
(?🖂 org-specific ":\\(EMAIL\\):" (org-mode) 1)
(?🔔 org-specific ":\\(FLAGGED\\|flagged\\):" (org-mode) 1)
(?☐ org-specific "\\(?:^*+ +\\)\\(\\<TODO\\>\\)" (org-mode) 1)
(?⯑ org-specific "\\(?:^*+ +\\)\\(\\<SOMEDAY\\>\\)" (org-mode) 1)
(?☑ org-specific "\\(?:^*+ +\\)\\(\\<DONE\\>\\)" (org-mode) 1)
(?✘ org-specific "\\(?:^*+ +\\)\\(\\<FAILED\\>\\)" (org-mode) 1)
(?✘ org-specific "\\(?:^*+ +\\)\\(\\<CANCELLED\\>\\)" (org-mode) 1)
(?▶ org-specific "\\(?:^*+ +\\)\\(\\<NEXT\\>\\)" (org-mode) 1)
(?🧠 org-specific "\\(?:^*+ +\\)\\(\\<TICKLER\\>\\)" (org-mode) 1)
(?🔁 org-specific "\\(?:^*+ +\\)\\(\\<MERGED\\>\\)" (org-mode) 1)
(?⌛ org-specific "\\(?:^*+ +\\)\\(\\<WAITING\\>\\)" (org-mode) 1)
(?⏩ org-specific "\\(?:^*+ +\\)\\(\\<DOING\\>\\)" (org-mode) 1)
(?⏸ org-specific "\\(?:^*+ +\\)\\(\\<HOLD\\>\\)" (org-mode) 1)
(?❄ org-specific "\\(?:^*+ +\\)\\(\\<FROZEN\\>\\)" (org-mode) 1)
(?🖹 org-specific "\\(?:^*+ +\\)\\(\\<REVIEW\\>\\)" (org-mode) 1)
(?☐ org-specific "\\[ \\]" (org-mode))
(?☑ org-specific "\\[X\\]" (org-mode))
(?❍ org-specific "\\[-\\]" (org-mode))
((yant/str-to-glyph "☠D") org-specific "\\<DEADLINE:" (org-mode))
((yant/str-to-glyph "◴S") org-specific "\\<SCHEDULED:" (org-mode))))))Prefer to replace default ... by something more distinct if item is folded
(setq org-ellipsis " ")
(set-face-underline 'org-ellipsis nil)blanks in items
;;turn off blanks in a new entries
(setq org-blank-before-new-entry (quote ((heading . nil)
(plain-list-item . nil))))
(setq org-cycle-separator-lines 0)hide emphasis markers
(setq org-hide-emphasis-markers t)keyword faces
(setq org-todo-keyword-faces
(quote (("TODO" :foreground "red" :weight bold)
("NEXT" :foreground "blue" :weight bold)
("DOING" :foreground "blue" :weight bold)
("SOMEDAY" :foreground "black" :weight bold)
("DONE" :foreground "forest green" :weight bold)
("FAILED" :foreground "red" :weight bold)
("WAITING" :foreground "orange" :weight bold)
("REVIEW" :foreground "orange" :weight bold)
("TICKLER" :foreground "black" :weight bold)
("HOLD" :foreground "magenta" :weight bold)
("CANCELLED" :foreground "gray80" :weight bold)
("FROZEN" :foreground "SkyBlue" :weight bold)
("MERGED" :foreground "light green" :weight bold))))truncation by default
(setq org-startup-truncated t)no leading stars
(setq org-hide-leading-stars t)no indentation inside entries
(setq org-adapt-indentation nil)show sticky headers on tall tables
(use-package org-table-sticky-header
:straight t
:diminish org-table-sticky-header-mode
:hook (org-mode . org-table-sticky-header-mode))hyphen as em-dash (from here)
(font-lock-add-keywords
'org-mode
'(("^[[:space:]]*\\(-\\) "
0 (prog1 () (compose-region (match-beginning 1) (match-end 1) "—")))))Do not adjust tags. It does not work well in resized windows without line truncation.
(setq org-tags-column 0)Always show the contents of inline tasks instead of hiding/showing it during cycling.
(remove-hook 'org-cycle-hook 'org-inlinetask-hide-tasks)Use smaller font for inline headings without keyword
(use-package org-inlinetask
:if init-flag
:hook (org-font-lock . yant/org-inlinetask-fontify-notodo)
:config
(defface org-inlinetask-notodo '((t :inherit shadow :height 0.8))
"Face for inlinetask headlines without todo keywords."
:group 'org-faces)
(defun yant/org-inlinetask-fontify-notodo (limit)
"Fontify the inline tasks with no todo keyword down to LIMIT."
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\*[ \t]+\\)")))
(org-back-to-heading-or-point-min 'invisible-ok)
(while (re-search-forward re limit t)
(unless (looking-at-p org-todo-regexp)
(add-text-properties (point) (line-end-position) `(face org-inlinetask-notodo font-lock-fontified t)))))))Hide END part of inline tasks
;; (add-hook! 'org-mode-hook (cursor-intangible-mode +1))
;; (add-hook! 'org-mode-hook (add-to-list 'font-lock-extra-managed-props 'display))
(use-package org-inlinetask
:if init-flag
:hook (org-font-lock . yant/org-inlinetask-hide-END)
:config
(defun yant/org-inlinetask-hide-END (limit)
"Hide END line of inlinetasks."
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\* END[ \t]*$\\)")))
(while (re-search-forward re limit t)
(with-silent-modifications
(compose-region (1- (match-beginning 0)) (match-end 0)
?🬉 'decompose-region)
)))))Disallow user edits inside property drawers
;; (add-hook! 'org-mode-hook (cursor-intangible-mode +1))
;; (use-package org-inlinetask
;; :if init-flag
;; :hook (org-font-lock . yant/org-intanglible-property)
;; :config
;; (defun yant/org-intanglible-property (limit)
;; "Make property drawers cursor intanglible."
;; (while (re-search-forward org-property-drawer-re limit t)
;; (with-silent-modifications
;; (save-excursion
;; (goto-char (match-beginning 0))
;; (forward-line)
;; (add-text-properties (point) (match-end 0)
;; `(cursor-intangible t)))))))fit inline LaTeX better by increasing the image size [credit]
(setq org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
\\usepackage[T1]{fontenc}
\\usepackage{mathtools}
\\usepackage{textcomp,amssymb}
\\usepackage[makeroom]{cancel}
\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
\\setlength{\\oddsidemargin}{1.5cm}
\\addtolength{\\oddsidemargin}{-2.54cm}
\\setlength{\\evensidemargin}{\\oddsidemargin}
\\setlength{\\textheight}{\\paperheight}
\\addtolength{\\textheight}{-\\headheight}
\\addtolength{\\textheight}{-\\headsep}
\\addtolength{\\textheight}{-\\footskip}
\\addtolength{\\textheight}{-3cm}
\\setlength{\\topmargin}{1.5cm}
\\addtolength{\\topmargin}{-2.54cm}
% my custom stuff
\\usepackage{arev}
\\usepackage{arevmath}")(use-package doom-themes
:if init-flag
:straight t
:config
(use-package doom-themes-ext-org
:demand t))Do not fontify done headlines
(use-package org
:custom
(org-fontify-done-headline nil))Highlight headings with :FLAGGED: tag
(use-package org
:if init-flag
:hook (org-font-lock . yant/org-fontify-flagged-headings)
:config
(defun yant/org-fontify-flagged-headings (limit)
"Fontify the FLAGGED headings down to LIMIT."
(let* ((nstars (if org-odd-levels-only
(1- (* 2 (or org-inlinetask-min-level 200)))
(or org-inlinetask-min-level 200)))
(re (concat "^\\(\\*\\)\\(\\*\\{"
(format "%d" (- nstars 3))
",\\}\\)\\(\\*\\*[ \t]+\\)")))
(org-back-to-heading-or-point-min 'invisible-ok)
(while (re-search-forward "^\\*+[ \t]+\\(.+:FLAGGED:[^ \t]+[ \t]*\\)$" limit t)
(add-text-properties (match-beginning 1) (1- (match-end 1)) `(face yant/org-agenda-highlight-face font-lock-fontified t))))))org-appear: Reveal hidden parts of links/emphasis when cursor enters them
(use-package org-appear
:if init-flag
:straight (org-appear :host github :repo "awth13/org-appear" :branch "feature/org-fold-support")
:custom (org-appear-autosubmarkers t)
:hook (org-mode . org-appear-mode))Align tags to right, even when the window size changes
not reliable, acts on first space in empty headline as wellENDit seems that org-align-tags intereferes with helm completion in bizarre way when tag string appears inside the completionEND(use-package org
:if init-flag
:custom
(org-auto-align-tags nil)
:config
(defun org-adaptive-fill-function ()
"Fill headlines to the beginning of headline in org."
(save-excursion
(cond
((org-at-heading-p)
(beginning-of-line)
(looking-at org-complex-heading-regexp)
(goto-char (or (match-beginning 4) (match-end 0))) ;; at headline
(make-string (current-column) ?\ ))
((org-at-item-p)
(beginning-of-line)
(looking-at org-list-full-item-re)
(goto-char (or (match-beginning 4) (match-end 3) (match-end 2) (match-end 1)))
(skip-chars-forward " \t")
(make-string (current-column) ?\ )))))
(add-hook! 'org-mode-hook (setq-local adaptive-fill-function #'org-adaptive-fill-function))
(defun yant/org-align-tags (limit &optional force)
"Align all the tags in org buffer."
(save-match-data
(when (eq major-mode 'org-mode)
(while (re-search-forward "^\\*+ \\(.+?\\)\\([ \t]+\\)\\(:\\(?:[^ \n]+:\\)+\\)$" limit t)
(when (and (match-string 2)
(or force
(not (get-text-property (match-beginning 2) 'org-tag-aligned))))
(with-silent-modifications
(put-text-property (match-beginning 2) (match-end 2) 'org-tag-aligned t)
(put-text-property (if (>= 2 (- (match-end 2) (match-beginning 2)))
(match-beginning 2)
;; multiple whitespaces may mean that we are in process of typing
(1+ (match-beginning 2)))
(match-end 2)
'display
`(space . (:align-to (- right
(,(+ (string-display-pixel-width org-ellipsis)
(string-display-pixel-width (or (match-string 3)
""))))))))))))))
;; (add-hook! 'pretty-symbols-mode-hook (save-excursion (goto-char (point-min)) (yant/org-align-tags (point-max) t)))
;; (add-hook! 'org-mode-hook (save-excursion (goto-char (point-min)) (yant/org-align-tags (point-max) t)) :append)
;; (add-hook 'org-mode-hook (lambda () (font-lock-add-keywords 'org-mode '(yant/org-align-tags) t)))
;; (add-hook! 'org-mode-hook (add-to-list 'font-lock-extra-managed-props 'org-tag-aligned))
)Agenda
[2020-04-10 Fri] Strange bug causing infinite loop in org-agenda-dim-blocked-tasks when I clock in a dimmed task.
SOMEDAY investigate thisEND(use-package org-agenda
:custom (org-agenda-dim-blocked-tasks nil))(defadvice org-agenda (around split-vertically activate)
(let ((split-width-threshold 1000)) ; or whatever width makes sense for you
ad-do-it))Do not highlight line below mouse
(defun yant/remove-mouse-highlight ()
"Remove all mouse highlights in buffer."
(let ((inhibit-read-only t))
(remove-text-properties
(point-min) (point-max) '(mouse-face t))))
(add-hook 'org-agenda-finalize-hook
#'yant/remove-mouse-highlight)Highlight current line in agenda
(use-package hl-line
:if init-flag
:diminish global-hl-line-mode
:config
(progn
(add-hook 'org-agenda-mode-hook
(lambda () (hl-line-mode 1))
'append)))Modify prefix for the entries to show if the entry is repeatable and the time time balance multiplier.
(setq org-agenda-scheduled-leaders '("* today" "* %2d d. ago"))
(defun yant/format-summary-for-agenda ()
"Format the contents of :SUMMARY: property to show in agenda view."
(let ((summary (org-entry-get (point) "SUMMARY")))
(if (not (seq-empty-p summary))
(format "[%s] " summary)
"")))
(defun yant/format-hashtags-for-agenda ()
"Format the list of hashtags to show in agenda view."
(let* ((entry-text (org-with-point-at-org-buffer
(org-back-to-heading)
;; Skip heading
(end-of-line 1)
;; Get entry text
(buffer-substring
(point)
(or (save-excursion (outline-next-heading) (point))
(point-max)))))
(entry-text (and entry-text (replace-regexp-in-string org-babel-src-block-regexp "" entry-text)))
(entry-hashtags (and entry-text (mapcar #'car (s-match-strings-all " #[^+ ][^# ]+" entry-text)))))
(if (seq-empty-p entry-hashtags)
""
(concat "\t\t" (mapconcat #'s-trim entry-hashtags " ") "\n"))))
(defun yant/format-time-balance-multiplier ()
"Format :ORG-TIME-BALANCE-MULTIPLIER: into agenda."
(condition-case nil
(save-match-data
(let* ((mult (org-ql--value-at (point) #'org-get-time-balance-multiplier-at-point))
(bonus (org-ql--value-at (point) #'org-get-org-time-bonus-on-done-at-point))
(schedule-string (or (org-entry-get (point) "SCHEDULED") ""))
(scheduled? (string-match org-repeat-re schedule-string))
(repeat-string (and scheduled? (match-string 1 schedule-string)))
(repeat-string (and scheduled? (replace-regexp-in-string "[+.]+" "" repeat-string))))
(format "%s%s%s" (if scheduled? (format "%-4s" (format "%s↰" repeat-string)) " ") (if mult (format "%+.1fx" mult) "")
(if (and bonus (> bonus 0)) (format "+%-3s" bonus) " "))))
(error "")))
(setq org-agenda-prefix-format '((agenda . "%-12.12s %-14.14:c [%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(search . "%s %-14.14:c [%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(todo . "%-14.14:c [%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(tags . "%-14.14:c [%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")))Hide some uninteresting tags
(setq org-agenda-hide-tags-regexp (rx-to-string '(or "DEFAULT"
"flagged"
"NOFOLLOW"
"TICKLER"
"SKIP"
"NOARCHIVE"
"INBOX"
"HOLD"
"WAITING"
"NODEADLINE"
"CANCELLED"
"NOCLOCK"
"NOREFILE"
"REFILE")))Shorten too long headlines in agenda. In order to make the remainder consistent, the multi-byte characters are considered to be double width and all headlines containing multi-byte characters are shortened to less chars accordingly.
the current implementation wrongly cuts linksENDthe idea about multi-byte is not good for Russian text having same width as English…ENDIn addition use :align-to =’display= spec to align tags to right border of the window.
(defun string-display-width (string &optional mode)
"Calculate diplayed column width of STRING.
Optional MODE specifies major mode used for display."
(with-temp-buffer
(with-silent-modifications
(setf (buffer-string) string))
(when (fboundp mode)
(funcall mode)
(font-lock-fontify-buffer))
(current-column)))
(defun string-display-truncate (string num &optional mode hide-p ellipsis)
"Trim displayed STRING to NUM columns.
Optional MODE specifies major mode used for display.
Non-nil HIDE-P means that the string should be trimmed by hiding the trailing part with text properties.
Optional ELLIPSIS string is shown in place of the hidden/deleted part of the string."
(let ((char-property-alias-alist-buffer char-property-alias-alist))
(with-temp-buffer
(setq-local char-property-alias-alist char-property-alias-alist-buffer)
(with-silent-modifications
(setf (buffer-string) string))
(when (fboundp mode)
(funcall mode)
(font-lock-fontify-buffer))
(when (> (current-column) num)
(move-to-column num)
(with-silent-modifications
(if hide-p
(progn
(if (stringp ellipsis)
(put-text-property (point) (point-max) 'display ellipsis)
(put-text-property (point) (point-max) 'invisible t))
(put-text-property (point) (point-max) 'truncated t))
(kill-line)
(when (stringp ellipsis) (insert ellipsis)))))
(buffer-string))))
(defun string-display-pixel-width (string &optional mode)
"Calculate pixel width of STRING.
Optional MODE specifies major mode used for display."
(let (wrap-prefix display-line-numbers)
(with-temp-buffer
(with-silent-modifications
(setf (buffer-string) string))
(when (fboundp mode)
(funcall mode)
(font-lock-fontify-buffer))
(if (get-buffer-window (current-buffer))
(car (window-text-pixel-size nil (line-beginning-position) (point)))
(set-window-buffer nil (current-buffer))
(car (window-text-pixel-size nil (line-beginning-position) (point)))))))
;; (defun org-agenda-fix-tag-alignment ()
;; "Use 'display :align-to instead of spaces in agenda."
;; (save-match-data
;; (goto-char (point-min))
;; (setq-local word-wrap nil) ; tags would be moved to next line if `word-wrap'` is non-nil and `truncate-lines' is nil
;; (while (re-search-forward org-tag-group-re nil 'noerror)
;; (put-text-property (match-beginning 0)
;; (match-beginning 1)
;; 'display
;; `(space . (:align-to (- right
;; (,(string-display-pixel-width (match-string 1) 'org-mode))
;; 1)))))))
(defun org-agenda-adaptive-fill-function ()
"Fill to the beginning of headline in agenda."
(save-excursion
(when-let ((txt (get-text-property (line-beginning-position) 'txt)))
(search-forward (substring txt 0 10))
(goto-char (match-beginning 0))
(when-let ((re (get-text-property (line-beginning-position) 'org-todo-regexp)))
(re-search-forward re (line-end-position) 't)
(re-search-forward org-priority-regexp (line-end-position) 't))
(make-string (1+ (current-column)) ?\ ))))
(defun org-agenda-truncate-headings (&rest _)
"Truncate agenda headings to fit the WINDOW width."
(with-silent-modifications
(when (and (eq major-mode 'org-agenda-mode)
(not org-agenda-columns-active))
(save-excursion
;; indent wrapped lines to the position below the begining of the heading string
(setq-local adaptive-fill-function #'org-agenda-adaptive-fill-function)
;; (setq-local truncate-lines nil)
;; (adaptive-wrap-prefix-mode +1)
;; cleanup earlier truncation
(let ((pos (point-min))
next)
(while (and (setq pos (next-single-char-property-change pos 'truncated nil (point-max)))
(setq next (next-single-char-property-change pos 'truncated nil (point-max)))
(get-text-property pos 'truncated))
(remove-text-properties pos next '(truncated nil invisible nil display nil))))
(let ((pos (point-min))
next)
(while (and (setq pos (next-single-char-property-change pos 'org-agenda-afterline nil (point-max)))
(setq next (next-single-char-property-change pos 'org-agenda-afterline nil (point-max)))
(get-text-property pos 'org-agenda-afterline))
(setf (buffer-substring pos next) "")))
(goto-char (point-min))
(let ((window-width (window-width))
(ellipsis "…")
(gap " "))
(while (and (setf (point) (next-single-char-property-change (point) 'org-hd-marker nil (point-max)))
(< (point) (point-max)))
(let* ((tag-width (when (re-search-forward org-tag-group-re (point-at-eol) 'noerror)
(string-display-width (match-string 1))))
(beg (point-at-bol))
(end (if tag-width (match-beginning 0) (point-at-eol)))
(tag-width (or tag-width 0)))
(setf (buffer-substring beg end)
(string-display-truncate (buffer-substring beg end)
(- window-width
tag-width
(string-display-width (s-concat ellipsis gap)))
nil 'hide ellipsis))
(goto-char (next-single-char-property-change (point-at-bol) 'truncated nil (point-at-eol)))
(let ((truncated-string (buffer-substring (point) (next-single-char-property-change (point) 'truncated nil (point-at-eol)))))
(unless (seq-empty-p truncated-string)
(remove-text-properties 0 (length truncated-string) '(truncated nil invisible nil display nil) truncated-string)
(add-text-properties 0 (length truncated-string) '(org-agenda-afterline t) truncated-string)
(end-of-line)
(insert (apply #'propertize ellipsis
(text-properties-at 0 truncated-string)))
(insert truncated-string)))
(end-of-line))))))))
;; (add-hook! 'org-agenda-finalize-hook #'org-agenda-fix-tag-alignment)
(add-hook! :append 'org-agenda-finalize-hook #'org-agenda-truncate-headings)
;; (add-hook! 'org-agenda-finalize-hook (add-hook! :local 'window-configuration-change-hook #'org-agenda-truncate-headings))(use-package org-agenda
:if init-flag
:custom-face
(org-scheduled-today ((t (:foreground "DarkSlateGray"))))
(org-agenda-done ((t . (:foreground "Springgreen4" :slant normal)))))Fontify agenda items properly
;; (define-advice org-agenda-format-item (:filter-return (item) remove-double-colons)
;; "Remove ::."
;; (s-replace-regexp "::+" ":" item))
;; (advice-remove 'org-agenda-format-item #'org-agenda-format-item@fontify-org)
;; (advice-remove 'org-agenda-format-item #'org-agenda-format-item@remove-double-colons)
;; Credit: https://www.reddit.com/r/orgmode/comments/i3upt6/prettifysymbolsmode_not_working_with_orgagenda/g0r5rx8/
;; (define-advice org-agenda-fix-displayed-tags (:filter-return (&rest args) my-fix-displayed-org-tags)
;; (let ((txt (car args)))
;; (with-temp-buffer
;; (org-mode)
;; (insert "* " txt)
;; (font-lock-ensure)
;; (goto-char (point-min))
;; (looking-at "^\\* \\(.*\\)$")
;; (match-string 1))))
;; (use-package org-agenda
;; :if init-flag
;; :config
;; (el-patch-feature org-agenda)
;; ;; calling `org-agenda-highlight-todo' breaks 'composition text property of todo keywords, which breaks pretty-symbols fontifications
;; ;; fixing the function to keep 'composition
;; (el-patch-defun org-agenda-highlight-todo (x)
;; (let ((org-done-keywords org-done-keywords-for-agenda)
;; (case-fold-search nil)
;; re
;; (el-patch-add composition-property))
;; (if (eq x 'line)
;; (save-excursion
;; (beginning-of-line 1)
;; (setq re (org-get-at-bol 'org-todo-regexp))
;; (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
;; (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
;; (add-text-properties (match-beginning 0) (match-end 1)
;; (list 'face (org-get-todo-face 1)))
;; (el-patch-add (setq composition-property (plist-get (text-properties-at (match-beginning 1)) 'composition)))
;; (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
;; (delete-region (match-beginning 1) (1- (match-end 0)))
;; (goto-char (match-beginning 1))
;; (insert (format org-agenda-todo-keyword-format s))
;; (el-patch-add (add-text-properties (match-beginning 1) (match-end 1) (list 'composition composition-property))))))
;; (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
;; (setq re (get-text-property 0 'org-todo-regexp x))
;; (when (and re
;; ;; Test `pl' because if there's no heading content,
;; ;; there's no point matching to highlight. Note
;; ;; that if we didn't test `pl' first, and there
;; ;; happened to be no keyword from `org-todo-regexp'
;; ;; on this heading line, then the `equal' comparison
;; ;; afterwards would spuriously succeed in the case
;; ;; where `pl' is nil -- causing an args-out-of-range
;; ;; error when we try to add text properties to text
;; ;; that isn't there.
;; pl
;; (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
;; x pl)
;; pl))
;; (add-text-properties
;; (or (match-end 1) (match-end 0)) (match-end 0)
;; (list 'face (org-get-todo-face (match-string 2 x)))
;; x)
;; (when (match-end 1)
;; (setq x
;; (concat
;; (substring x 0 (match-end 1))
;; (format org-agenda-todo-keyword-format
;; (match-string 2 x))
;; ;; Remove `display' property as the icon could leak
;; ;; on the white space.
;; (org-add-props " " (org-plist-delete (text-properties-at 0 x)
;; 'display))
;; (substring x (match-end 3)))))))
;; x)))
;; )
Update highlight from currently clocked task in agenda even if the task was clocked in/out from outside
Agenda has a nice feature to highlight the currently clocked task, if it is present in agenda.
It is working by default when the clocking in/out is done from inside agenda (using org-agenda-clock-in/out commands).
However, the highlight is not updated if I clock in/out a task from outside the agenda buffer using more generic org-clock-in/out commands.
The code below does the trick.
(when init-flag
(defun yant/org-agenda-unmark-clocking-task ()
"Hide all org-quick-peek overlays in `org-agenda-buffer'."
(dolist (agenda-buffer (mapcar #'get-buffer
(seq-filter (apply-partially #'s-contains-p "*Org Agenda")
(mapcar #'buffer-name (buffer-list)))))
(when (buffer-live-p agenda-buffer)
(with-current-buffer agenda-buffer (org-agenda-unmark-clocking-task)))))
(defun yant/org-agenda-mark-clocking-task ()
"Hide all org-quick-peek overlays in `org-agenda-buffer'."
(dolist (agenda-buffer (mapcar #'get-buffer
(seq-filter (apply-partially #'s-contains-p "*Org Agenda")
(mapcar #'buffer-name (buffer-list)))))
(when (buffer-live-p agenda-buffer)
(with-current-buffer agenda-buffer (org-agenda-mark-clocking-task)))))
(add-hook 'org-clock-out-hook #'yant/org-agenda-unmark-clocking-task)
(add-hook 'org-clock-in-hook #'yant/org-agenda-mark-clocking-task))Show todo state changes in overlay in agenda similarly to how rescheduling is shown
In the case if todo state is changed, indicate the change in agenda.
Special treatment here is done for DOING todo keyword.
Since DOING->DOING transition is actually meaningful, also indicate DOING->DOING transition.
(use-package org-agenda
:config
(el-patch-feature org-agenda)
(el-patch-defun org-agenda-todo (&optional arg)
"Cycle TODO state of line at point, also in Org file.
This changes the line at point, all other lines in the agenda referring to
the same tree node, and the headline of the tree node in the Org file."
(interactive "P")
(org-agenda-check-no-diary)
(org-agenda-maybe-loop
#'org-agenda-todo arg nil nil
(let* ((col (current-column))
(marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
(todayp (org-agenda-today-p (org-get-at-bol 'day)))
(inhibit-read-only t)
org-loop-over-headlines-in-active-region
org-agenda-headline-snapshot-before-repeat newhead just-one
(el-patch-add todo-from todo-to))
(el-patch-add
(save-excursion
(beginning-of-line 1)
(setq re (org-get-at-bol 'org-todo-regexp))
(goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
(when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
(setq todo-from (match-string-no-properties 1)))))
(org-with-remote-undo buffer
(with-current-buffer buffer
(widen)
(goto-char pos)
(org-show-context 'agenda)
(let ((current-prefix-arg arg))
(call-interactively 'org-todo))
(and (bolp) (forward-char 1))
;; We need to update the effort text property at changed TODO
;; keyword.
(when (org-entry-get (point) "EFFORT")
(org-refresh-property '((effort . identity)
(effort-minutes . org-duration-to-minutes))
(org-entry-get (point) "EFFORT")))
(setq newhead (org-get-heading))
(when (and (bound-and-true-p
org-agenda-headline-snapshot-before-repeat)
(not (equal org-agenda-headline-snapshot-before-repeat
newhead))
todayp)
(setq newhead org-agenda-headline-snapshot-before-repeat
just-one t))
(save-excursion
(org-back-to-heading)
(move-marker org-last-heading-marker (point))))
(beginning-of-line 1)
(save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
(el-patch-add
(save-excursion
(beginning-of-line 1)
(setq re (org-get-at-bol 'org-todo-regexp))
(goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
(when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
(setq todo-to (match-string-no-properties 1)))))
(el-patch-add
(unless (and (not (string= "DOING" todo-from)) (string= todo-from todo-to))
(org-agenda-show-new-time (org-get-at-bol 'org-marker) todo-to (format " %s " todo-from))))
(when (bound-and-true-p org-clock-out-when-done)
(string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
newhead)
(org-agenda-unmark-clocking-task))
(org-move-to-column col)
(org-agenda-mark-clocking-task))))))Do not show tooltips in agenda
Tooltips are useless since I don’t use mouse in Emacs. I already force the mouse out, but the tooltips can still show up annoyingly if the mouse is accidentally left within the Emacs frame.
(use-package org-agenda
:init
(defun yant/remove-help-echo-in-buffer ()
"Remove helm-echo text property in the buffer text."
(remove-text-properties (point-min) (point-max) '(help-echo t)))
:config
(add-hook 'org-agenda-finalize-hook #'yant/remove-help-echo-in-buffer))Another source of tooltips in agenda is overlay marking currently clocked-in task. Patching the relevant function to not put that tooltip into the overlay.
(use-package org-agenda
:config
(el-patch-feature org-agenda)
(el-patch-defun org-agenda-mark-clocking-task ()
"Mark the current clock entry in the agenda if it is present."
;; We need to widen when `org-agenda-finalize' is called from
;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
(when (bound-and-true-p org-clock-current-task)
(save-restriction
(widen)
(org-agenda-unmark-clocking-task)
(when (marker-buffer org-clock-hd-marker)
(save-excursion
(goto-char (point-min))
(let (s ov)
(while (setq s (next-single-property-change (point) 'org-hd-marker))
(goto-char s)
(when (equal (org-get-at-bol 'org-hd-marker)
org-clock-hd-marker)
(setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
(overlay-put ov 'type 'org-agenda-clocking)
(overlay-put ov 'face 'org-agenda-clocking)
(el-patch-remove
(overlay-put ov 'help-echo
"The clock is running in this item")))))))))))Main face
Use normal colour for the default agenda face
(set-face-attribute 'org-agenda-structure nil
:foreground (face-foreground 'default))Highlight items with :FLAGGED: tag
(use-package org
:requires macrostep
:config
(defface yant/org-agenda-highlight-face `((t :inherit modus-themes-nuanced-yellow))
"Face used to highlight flagged entries in agenda view.")
(defun yant/org-agenda-highlight-flagged ()
"Highlight flagged items in agenda."
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
(while (re-search-forward ":FLAGGED:" nil t)
(font-lock-append-text-property (line-beginning-position) (line-end-position) 'face 'yant/org-agenda-highlight-face)))))
(add-hook 'org-agenda-finalize-hook
#'yant/org-agenda-highlight-flagged))
Blocks (source blocks, quotes, etc)
[2020-09-04 Fri] Disabling source block fontification - it is slow on large src blocks(setq org-src-fontify-natively t
org-src-tab-acts-natively nil ;; see https://lists.gnu.org/archive/html/emacs-orgmode/2019-12/msg00318.html
org-src-preserve-indentation t
org-hide-block-startup nil)Hide all blocks on startup [credit] [2021-03-21 Sun] Disabling to reduce startup time
(add-hook 'org-mode-hook #'org-fold-hide-block-all)Property drawers
Smaller font for property drawers
(use-package org
:custom-face
(org-drawer ((t (:foreground "Blue1" :height 0.8)))))Hide property drawers if they are empty or contain only invisible org-custom-properties.
Also hide the logbooks containing only state changes and clocking.
Find a faster way to hide empty drawers - maybe use font lockEND(use-package org
:if init-flag
:config
(setq org-custom-properties '("ID" "STYLE" "REPEAT_TO_STATE" "CREATED"))
(defvar-local org--hide-custom-properties nil
"When non-nil, hide properties listed in `org-custom-properties'.
If a property drawer conatins only these properties, hide the drawer as well.")
(defvar org--custom-properties-re (concat "^[ \t]*:" (regexp-opt org-custom-properties) ":.*")
"Regexp to match property lines from `org-custom-properties'.")
;; (defvar org-custom-logs '(state reschedule delschedule redeadline deldeadline refile)
;; "List of note types to be hidden normally. The types shouls be from `org-log-note-headings'.")
;; (defvar org-custom-drawers (list #'org-log-into-drawer "PROPERTIES")
;; "List of drawer names allowed to be hidden if all the information inside is invisible.")
;; (defvar org-custom-clocking-info t
;; "Non nil means that clocking info is hidden by `org-toggle-custom-properties-visibility'.")
(defun org-toggle-custom-properties-visibility (&optional arg)
"Toggle visibility of properties listen in `org-custom-properties'.
If a property drawer conatins only these properties, hide the drawer as well."
(interactive "p")
(if (or org--hide-custom-properties
(< arg 0))
(progn
(setq org--hide-custom-properties nil)
(remove-hook 'org-font-lock-hook #'org--hide-custom-properties)
(advice-remove 'org-cycle #'org--hide-custom-properties))
(setq org--hide-custom-properties t)
(setq org--custom-properties-re (concat "^[ \t]*:" (regexp-opt org-custom-properties) ":.*"))
(advice-add 'org-cycle :after #'org--hide-custom-properties)
(add-hook 'org-font-lock-hook #'org--hide-custom-properties))
(font-lock-fontify-buffer))
(defun org--hide-custom-properties (&optional limit)
"Hide the properties according to `org--hide-custom-properties'."
(unless (numberp limit) (setq limit (point-max)))
(when org--hide-custom-properties
(with-silent-modifications
(let ((re-drawer (concat "^[ \t]*:PROPERTIES:[ \t]*\n"
"\\(" org--custom-properties-re "\n\\)+"
"[ \t]*:END:[ \t]*\n"))
(re-single (concat org--custom-properties-re "\n")))
(save-excursion
(while (re-search-forward re-drawer limit t)
(put-text-property (match-beginning 0) (match-end 0) 'invisible t)))
(save-excursion
(while (re-search-forward re-single limit t)
(put-text-property (match-beginning 0) (match-end 0) 'invisible t)))))))
)Symbols
Use UTF symbols for entities
(setq org-pretty-entities t)
(setq org-pretty-entities-include-sub-superscripts t)Only use curly brackets to identify sub/superscripts (from here)
(setq org-use-sub-superscripts '{})Eldoc integration
(use-package org-eldoc
:after org
:demand t)Optimize fontification of priorities
To my horror, a single org-font-lock-add-priority-faces takes 98% of the whole font-locking makeing the opening take of huge (2M, thousands of headlines) org file several minutes.
[2020-07-28 Tue] Apparently the reason is because default regex can match too many things in my files. For now, just removed those long lines causing regexp search to be extremely slow.
Misc
(setq org-catch-invisible-edits 'smart)
(setq org-startup-folded nil)
(setq org-fold-show-context-detail
'((agenda . lineage) ;; instead of "local"
(bookmark-jump . lineage)
(isearch . lineage)
))Org element cache
I was irritated by org-mode behaviour when flycheck is turned on. org-mode introduces additional flycheck hook, which is ran after movement/editing commands. This hook calls org-element-at-point, which is terrible on large files.
Turning on org element cache in attempt to make it faster.
[2019-08-27 Tue] Disabling cache for now due to strange errors. Most commonly “Wrong side of point” [2020-05-25 Mon] Trying again [2020-07-15 Wed] Again getting strange errors. Probably related to native-comp [2020-08-02 Sun] Retrying again [2020-08-27 Thu] Disabling because of strange hangs [2021-02-13 Sat] Trying again [2021-03-13 Sat] Disabling. It hangs Emacs when syncing cache in inbox buffer after multiple refiles (deletions) from the buffer. [2021-05-05 Wed] Trying again [2021-08-15 Sun] Trying again [2021-08-16 Mon] Disabling until I fix tests and issue with incorrectly found IDs during tangle
(custom-set-variables '(org-element-use-cache t))
(custom-set-variables '(org-element--cache-self-verify 'backtrace))
(custom-set-variables '(org-element--cache-self-verify-frequency 0.03))Org mode editing
- Refiled on [2020-04-14 Tue 15:51]
(use-package org
:config
(use-package meta-functions
:config
(meta-defun meta-cut-element :mode org-mode :cond org-at-heading-p org-cut-subtree)))Notmuch interaction
(use-package ol-notmuch
:after org
:init (require 'notmuch)
:custom
(org-notmuch-open-function (lambda (link) (if (string-match-p "thread:" link)
(org-notmuch-tree-follow-link link)
(org-notmuch-tree-follow-link link)))))
(use-package helm-notmuch
:straight t
:after (notmuch helm)
:config
(let ((helm-source-notmuch-action (alist-get 'action helm-source-notmuch)))
(setf (alist-get 'action helm-source-notmuch)
(append helm-source-notmuch-action (list '("Copy message link" . org-store-notmuch-link))))))
(defun org-store-notmuch-link (CANDIDATE)
"Store CANDIDATE org link to notmuch message."
(let ((link (format "notmuch:%s" CANDIDATE)))
(interactive)
(org-open-link-from-string link)
(set-buffer (first (buffer-list)))
(let ((desc (replace-regexp-in-string "\\[\\|\\]" "" (notmuch-show-get-subject))))
(notmuch-bury-or-kill-this-buffer)
(push (list (format "notmuch:%s" CANDIDATE) desc) org-stored-links))))
(defun yant/add-email-to-task (&optional ARG)
"Add an email into :EMAIL-SOURCE: property of the task.
C-u argument means that we add the last link from link ring."
(interactive)
(if (eq ARG '4)
(let ((last-link (car (car org-stored-links)))
(last-description (cadr (car org-stored-links))))
(if (string-match "^notmuch.*$" last-link)
(progn
(org-set-property "EMAIL-SOURCE" (concat "[[" last-link "][" last-description "]]"))
(org-back-to-heading)
(org-set-tags-to (append (org-get-tags nil t) '("EMAIL"))))
(message "Link \"%s\" is not a message link." last-link))
(yant/mark-linked-email-after-todo-state-change))
(let ((helm-source-tmp (copy-alist helm-source-notmuch)))
(setf (alist-get 'action helm-source-tmp) (list '("Copy message link" . org-store-notmuch-link)))
(setf (alist-get 'header-line helm-source-tmp) "C-j: Associate the task with an email")
(helm :sources helm-source-tmp
:buffer "*helm notmuch*"
:truncate-lines t))
(yant/add-email-to-task '4)))
(defun yant/mark-linked-email-after-todo-state-change ()
"Remove track tag from a linked email :EMAIL-SOURCE: after the task is marked as finished."
(let* ((mystate (or (and (fboundp 'org-state) state)
(nth 2 (org-heading-components))))
(email-link (or (org-entry-get nil "EMAIL-SOURCE")
(org-entry-get nil "LINK")
))
(email-link (and email-link
(save-match-data
(string-match "^\\(?:\\[\\[\\)?\\(notmuch.+?\\)\\(?:\\]\\]\\)?$" email-link)
(match-string 1 email-link))))
(done-keywords org-done-keywords))
(when (and email-link
(not (string-empty-p email-link)))
(save-match-data
(string-match "^notmuch:\\(.+\\)" email-link)
(setq email-link (match-string 1 email-link)))
(if (member mystate done-keywords)
(call-process notmuch-command nil nil nil "tag" "-track" "--" email-link)
(call-process notmuch-command nil nil nil "tag" "-todo" "--" email-link)))))
(add-hook 'org-after-todo-state-change-hook 'yant/mark-linked-email-after-todo-state-change 'append)
(add-hook 'org-capture-before-finalize-hook 'yant/mark-linked-email-after-todo-state-change 'append)Imenu integration
Imenu appears to be slower in org-mode in comparison with org-goto
;; (setq org-imenu-depth 8)
(use-package meta-functions
:if init-flag
:after helm-org-ql
:config
(meta-defun meta-goto :mode org-mode (helm-org-ql (current-buffer) :narrow t)))Magit integration
Auto-commit trivial changes in org files
#autocommitSome changes in org-files are very trivial and clutter more important changes I actually want to keep an eye on. So, I made a command hiding the trivial changes.
(use-package magit
:if init-flag
:after magit
:config
(defvar yant/magit-show-autocommit-regexps '("^\\(-\\|\\+\\)[ \t]*:SHOWFROMDATE:.+\n"
"^\\(-\\|\\+\\)[ \t]*:Effort:.+\n"
"^\\(-\\|\\+\\)[ \t]*:SUMMARY:.+\n"
"^\\(\\+\\|-\\)[ \t]*- State .+from.+\n"
"^\\(-\\|\\+\\)[ \t]*:LAST_REPEAT: \\[.+\n"
"^\\(-\\|\\+\\)[ \t]*:ORG-TIME-BONUS:.+\n"
"^\\(-\\|\\+\\)[ \t]*CLOCK: \\[.+\n"
"^\\(-\\|\\+\\)[ \t]*SCHEDULED: .+\n"
"^\\(-\\|\\+\\)[ \t]*$"
"^[ \t]*\\(-\\|\\+\\)[ \t]*- Refiled on .+\n"
"^\\(-\\|\\+\\)[ \t]*:PROPERTIES:[ \t]*\n"
"^\\(-\\|\\+\\)[ \t]*:LOGBOOK:[ \t]*\n"
"^\\(-\\|\\+\\)[ \t]*:END:[ \t]*\n"
"^\\(-\\|\\+\\)[ \t]*:TITLE: .+\n"
"^\\(-\\|\\+\\)[ \t]*:BTYPE: .+\n"
"^\\(-\\|\\+\\)[ \t]*:TYPEALT: .+\n"
"^\\(-\\|\\+\\)[ \t]*:MERGED-WITH: .+\n"
"^\\(-\\|\\+\\)[ \t]*:KEYWORDS: .+\n"
"^\\(-\\|\\+\\)[ \t]*:AUTHOR: .+\n"
"^\\(-\\|\\+\\)[ \t]*:JOURNAL: .+\n"
"^\\(-\\|\\+\\)[ \t]*:VOLUME: .+\n"
"^\\(-\\|\\+\\)[ \t]*:PAGES: .+\n"
"^\\(-\\|\\+\\)[ \t]*:NUMBER: .+\n"
"^\\(-\\|\\+\\)[ \t]*:DOI: .+\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] download and attach pdf.*\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] \\[\\[elisp:org-attach-open\\]\\[read paper capturing interesting references\\]\\].*\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] \\[\\[elisp:(browse-url (url-encode-url (format \"https://www\\.semanticscholar\\.org/search\\?q=%s\" (org-entry-get nil \"TITLE\"))))\\]\\[check citing articles\\]\\].*\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] \\[\\[elisp:(browse-url (url-encode-url (format \"https://www\\.connectedpapers\\.com/search\\?q=%s\" (org-entry-get nil \"TITLE\"))))\\]\\[check related articles\\]\\].*\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] check if bibtex entry has missing fields.*\n"
"^\\(-\\|\\+\\)[ \t]*- \\[.\\] Consider subscribing to new citations.*\n"
"^\\(-\\|\\+\\)[ \t]*:PUBLISHER: .+\n"
"^\\(-\\|\\+\\)[ \t]*:EMAIL-SOURCE: .+\n"
"^\\(-\\|\\+\\)[ \t]*:Source: .+\n"
"^\\(-\\|\\+\\)[ \t]*:CREATED: .+\n"
"^\\(-\\|\\+\\)[ \t]*:HOWPUBLISHED: .+\n"
"^\\(-\\|\\+\\)[ \t]*:NOTE: .+\n"
"^\\(-\\|\\+\\)[ \t]*:URL: .+\n"
"^\\(-\\|\\+\\)[ \t]*:LINK: .+\n"
"^\\(-\\|\\+\\)[ \t]*:YEAR: .+\n"
"^\\(-\\|\\+\\)[ \t]*:ID: .+\n"
"^\\(-\\|\\+\\)CLOSED:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_LAST_INTERVAL:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_REPEATS_SINCE_FAIL:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_FAILURE_COUNT:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_TOTAL_REPEATS:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_AVERAGE_QUALITY:.+\n"
"^\\(-\\|\\+\\)[ \t]*:DRILL_EASE:.+\n"
"^\\(-\\|\\+\\)[ \t]*:ARCHIVE_[^:]+:.+\n"
"^\\+CLOSED:.+\n"
"^\\-SCHEDULED:.+\n"
"^[+-]DEADLINE:.+\n"
)
"List of regexps hide in magit buffer.")
(defun yant/magit-org-hide-boring ()
"Hide `yant/magit-show-autocommit-regexps' from all the chunks."
(interactive)
(unless (eq major-mode 'magit-status-mode)
(user-error "Thus command should run in magit-status window."))
(magit-section-show-level-4-all)
(save-excursion
(magit-jump-to-unstaged)
(let ((staged-pos (or (save-excursion
(unless (let ((inhibit-message t)) (magit-jump-to-staged))
(point)))
(point-max)))
(re (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) yant/magit-show-autocommit-regexps)))))
(while (< (point) staged-pos)
(when (and (re-search-forward re nil 'move)
(< (point) staged-pos))
(with-silent-modifications
(put-text-property (match-beginning 0) (match-end 0) 'invisible t)))))))
(add-hook 'magit-status-sections-hook #'yant/magit-org-hide-boring 100)
(defun thread-yield-safe (&rest _)
"Call `thread-yield' preserving buffer and point."
(let ((buf-- (current-buffer))
(mk-- (point-marker)))
(thread-yield)
(set-buffer buf--)
(goto-char mk--)))
(defmacro with-async-calls (functions &rest body)
"Execute BODY with every function symbol in FUNCTIONS list followed by `thread-yield-safe'."
(declare (debug (form body)) (indent 1))
`(progn
(mapc (lambda (f) (advice-add f :after #'thread-yield-safe)) ,functions)
(unwind-protect
;; Otherwise, we may end up changing point and buffer position.
(cl-letf (((symbol-function 'sleep-for) #'thread-yield-safe))
(progn ,@body))
(mapc (lambda (f) (advice-remove f #'thread-yield-safe)) ,functions))))
(defun yant/magit-autocommit ()
"Asynchronously commit all the lines matching `yant/magit-show-autocommit-regexps'."
(interactive)
(make-thread #'yant/magit--autocommit "Magit autocommit"))
(defun yant/magit--autocommit ()
"Commit all the lines matching `yant/magit-show-autocommit-regexps'."
(interactive)
(unless (eq major-mode 'magit-status-mode)
(user-error "Thus command should run in magit-status window."))
(magit-section-show-level-4-all)
(magit-jump-to-unstaged)
;; Make Emacs responsive while staging.
(with-async-calls '(magit-insert-heading magit-section-ident-value)
(let ((magit-buffer (current-buffer))
(pos (point))
(progress (make-progress-reporter "Autocommiting hunks..." 1 (point-max)))
(staged-pos (or (save-excursion
(unless (let ((inhibit-message t)) (magit-jump-to-staged))
(point)))
(point-max))))
(while (with-current-buffer magit-buffer
(< pos staged-pos))
(with-current-buffer magit-buffer
(save-excursion
(goto-char pos)
(progress-reporter-update progress (+ pos (- (point-max) staged-pos)))
(when (and (re-search-forward (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) yant/magit-show-autocommit-regexps))) nil 'move)
(< (point) staged-pos))
(let ((section (magit-current-section)))
(if (not (eq 'hunk (oref section type)))
(magit-section-forward)
(let ((hunk-text (buffer-substring-no-properties (oref section start) (oref section end))))
(if (with-temp-buffer
(insert hunk-text)
(goto-char 1)
(keep-lines "^[+-].+$")
(mapc (lambda (regexp)
(goto-char 1)
(delete-matching-lines regexp))
yant/magit-show-autocommit-regexps)
(string-empty-p (buffer-string)))
(progn
(magit-stage)
;; Stage will rebuild status buffer from
;; scratch, so we have to restart or can
;; miss some matches.
(setq pos 1))
(magit-section-forward))))))
(setq pos (point))
(setq staged-pos (or (save-excursion
(unless (let ((inhibit-message t)) (magit-jump-to-staged))
(point)))
(point-max))))))
(progress-reporter-done progress)
(with-current-buffer magit-buffer
(unless (magit-jump-to-staged) ;; returns nil on success.
(funcall-interactively #'magit-commit-create)
(while (not (get-buffer "COMMIT_EDITMSG")) (sleep-for 3) (message "Waiting for commit buffer..."))
(with-current-buffer "COMMIT_EDITMSG"
(insert (format-time-string "Autoupdate %Y-%m-%d" (current-time))))))))))Spell checking
Spell check rules for org syntax.
Partially stolen from https://github.com/grettke/help/blob/master/help.org:
(defun help/block-regex (special)
"Make an ispell skip-region alist for a SPECIAL block."
(interactive)
`(,(concat "^[ ]*#[+][bB][eE][gG][iI][nN]_" special)
.
,(concat "^[ ]*#[+][eE][nN][dD]_" special)))
;; from https://github.com/wdenton/.emacs.d/blob/master/setup/setup-orgmode.el
;; Use LaTeX spell-check
(add-hook 'org-mode-hook (lambda () (setq ispell-parser 'tex)))
;; Ispell should ignore some things in Org files
;; http://endlessparentheses.com/ispell-and-org-mode.html
(defun endless/org-ispell ()
"Configure `ispell-skip-region-alist' for `org-mode'."
(make-local-variable 'ispell-skip-region-alist)
(add-to-list 'ispell-skip-region-alist '(org-property-drawer-re))
(add-to-list 'ispell-skip-region-alist '(org-any-link-re))
(add-to-list 'ispell-skip-region-alist '("<<[A-Za-z-0-9]+>>"))
(add-to-list 'ispell-skip-region-alist '("=[^=]+="))
(add-to-list 'ispell-skip-region-alist '("^# +-\\*-*+$"))
(add-to-list 'ispell-skip-region-alist (help/block-regex "[Ss][rR][cC]"))
(let ()
(--each
'(("ATTR_LATEX" nil)
("AUTHOR" nil)
("SETUPFILE" t)
("BLOG" nil)
("CREATOR" nil)
("DATE" nil)
("DESCRIPTION" nil)
("EMAIL" nil)
("EXCLUDE_TAGS" nil)
("HTML_CONTAINER" nil)
("HTML_DOCTYPE" nil)
("HTML_HEAD" nil)
("HTML_HEAD_EXTRA" nil)
("HTML_LINK_HOME" nil)
("HTML_LINK_UP" nil)
("HTML_MATHJAX" nil)
("INFOJS_OPT" nil)
("KEYWORDS" nil)
("LANGUAGE" nil)
("LATEX_CLASS" nil)
("LATEX_CLASS_OPTIONS" nil)
("LATEX_HEADER" nil)
("LATEX_HEADER_EXTRA" nil)
("NAME" t)
("name" t)
("OPTIONS" t)
("PROPERTY" t)
("POSTID" nil)
("RESULTS" t)
("SELECT_TAGS" nil)
("STARTUP" nil)
("TITLE" nil))
(add-to-list
'ispell-skip-region-alist
(let ((special (concat "#[+]" (car it) ":")))
(if (cadr it)
(cons special "$")
(list special)))))))
(add-hook 'org-mode-hook #'endless/org-ispell)Org crypt
(use-package org-crypt
:after org
:custom
(org-crypt-key "Ihor Radchenko")
:config
(org-crypt-use-before-save-magic))Allow tangling encrypted files
#tangle #crypt- Alternative implementation: [[id:56e0107a731598b9f203e3af0b71349f00985f63][/u/negativeoilprice [Reddit:planetemacs] (2020) Andrea: Org crypt and tangling source blocks]]
(use-package org-crypt
:config
(use-package ob-tangle
:after org-ql
:config
(defun yant/org-decrypt-for-tangle-maybe ()
"Decrypt entries in buffer when they have TANGLE tag."
(require 'org-ql)
(org-ql-query :select #'org-decrypt-entry
:from (current-buffer)
:where '(and (tags-local "crypt")
(tags-local "TANGLE"))
:narrow t))
(add-hook 'org-babel-pre-tangle-hook #'yant/org-decrypt-for-tangle-maybe 100)))Refresh keywords upon decryption
(use-package org-crypt
:config
(defun yant/org-refresh-org-buffer ()
"Refresh org buffer as if C-c C-c on a keyword line."
(org-set-regexps-and-options))
(define-advice org-decrypt-entry (:after (&rest _) refresh-org)
(when (member "crypt" (org-get-tags nil 'local))
(yant/org-refresh-org-buffer))))Speed up saving files without encrypted headings
By default, org-crypt uses slow org-scan-tags to match headings to be encrypted before save. However, it is very too slow on large files and takes time even when those files do not even contain encrypted headings.
Advising org-encrypt-entries to skip files without org-crypt-tag-matcher tags.
(use-package org-crypt
:if init-flag
:config
(define-advice org-encrypt-entries (:override () skip-files-without-crypt-tag)
"Skip processing files that do not contain `org-crypt-tag-matcher' tags."
(org-with-wide-buffer
(goto-char 1)
(while (re-search-forward (format ":%s:" org-crypt-tag-matcher) nil t)
(when (member org-crypt-tag-matcher (org-get-tags nil 'local))
(org-encrypt-entry)
(outline-next-heading))))))SOMEDAY Knowledge graph view
Key combinations
(when init-flag
(use-package meta-functions
:config
(meta-defun meta-org-clock-goto "Goto clocked in entry" org-clock-goto)
(meta-defun meta-org-clock-goto :mode org-agenda-mode org-agenda-clock-goto)
(bind-key "C-c c" #'meta-org-clock-goto))
(bind-keys
("C-c C-S-l" . org-store-link)
("C-c m" . org-capture)
:map boon-goto-map
("a" . org-agenda)
("C-t" . gtd-open)
("C-n" . notes-open)
)
(bind-keys :map org-mode-map
("C-c C-l" . org-insert-link)
("C-c C-+" . add-current-buffer-to-agenda-files)
("C-c C--" . remove-current-buffer-from-agenda-files)
("C-c e" . yant/add-email-to-task)
("C-c i" . org-clock-in)
("C-c o" . org-clock-out)
:map org-agenda-mode-map
("C-c C-," . org-agenda-priority)
("s" . org-agenda-bulk-mark)
("S" . org-agenda-bulk-mark-all)
("a" . org-agenda-bulk-unmark)
("A" . org-agenda-bulk-unmark-all)
("i" . org-agenda-clock-in)
("-" . meta-undo)
:map narrow-map
("s" . org-narrow-to-subtree)
)
(use-package meta-functions
:config
(meta-defun meta-move-line-up :mode org-mode org-metaup)
(meta-defun meta-move-line-down :mode org-mode org-metadown)
(meta-defun meta-move-element-up :mode org-mode org-shiftmetaup)
(meta-defun meta-move-element-down :mode org-mode org-shiftmetadown)
(meta-defun meta-move-element-left :mode org-mode org-shiftmetaleft)
(meta-defun meta-move-element-right :mode org-mode org-shiftmetaright)
(meta-defun meta-move-line-left :mode org-mode org-metaleft)
(meta-defun meta-move-line-right :mode org-mode org-metaright)
(meta-defun meta-insert-enclosure-new-line :mode org-mode org-insert-heading-respect-content)
(meta-defun meta-insert-active-enclosure-new-line :mode org-mode org-insert-todo-heading-respect-content)
(meta-defun meta-new-line :mode org-mode (org-return))
(defun yant/org-smart-meta-down-element ()
"Move down org item if at heading, move down paragraph otherwise."
(interactive)
(if (org-at-heading-p)
(call-interactively #'org-next-visible-heading)
(forward-paragraph)))
(defun yant/org-smart-meta-up-element ()
"Move up org item if at heading, move up paragraph otherwise."
(interactive)
(if (org-at-heading-p)
(call-interactively #'org-previous-visible-heading)
(backward-paragraph)))
(meta-defun meta-down-element
:mode org-mode
:cond org-at-heading-p
:cond (not (buffer-narrowed-p))
(outline-get-next-sibling))
(meta-defun meta-down-element
:mode org-mode
:cond org-at-heading-p
:cond buffer-narrowed-p
(let ((curpos (point)))
(unless (outline-get-next-sibling)
(goto-char curpos)
(widen)
(outline-get-next-sibling)
(org-narrow-to-subtree)
(org-fold-show-children))))
(meta-defun meta-down-element
:mode org-mode
:cond (let ((element (org-element-at-point))) (and (eq (org-element-type element) 'src-block) (eq (1+ (point)) (org-element-property :end element))))
(progn
(goto-char (org-element-property :begin (org-element-at-point)))
(next-line)
;; (org-hide-block-toggle 'hide)
(org-babel-next-src-block 1)
(org-fold-hide-block-toggle 'off))
:mode org-mode
:cond (eq (org-element-type (org-element-at-point)) 'src-block)
(goto-char (1- (org-element-property :end (org-element-at-point)))))
(meta-defun meta-up-element
:mode org-mode
:cond org-at-heading-p
:cond (not (buffer-narrowed-p))
(outline-get-last-sibling))
(meta-defun meta-up-element
:mode org-mode
:cond org-at-heading-p
:cond buffer-narrowed-p
(let ((curpos (point)))
(unless (outline-get-last-sibling)
(goto-char curpos)
(widen)
(outline-get-last-sibling)
(org-narrow-to-subtree)
(org-show-children))))
(meta-defun meta-up-element
:mode org-mode
:cond (let ((element (org-element-at-point))) (and (eq (org-element-type element) 'src-block) (eq (point) (org-element-property :begin element))))
(progn
;; (org-hide-block-toggle 'hide)
(org-babel-previous-src-block 1)
(org-fold-hide-block-toggle 'off))
:mode org-mode
:cond (eq (org-element-type (org-element-at-point)) 'src-block)
(goto-char (org-element-property :begin (org-element-at-point))))
(meta-defun meta-move-line-up :mode org-struct-mode org-metaup)
(meta-defun meta-move-line-down :mode org-struct-mode org-metadown)
(meta-defun meta-move-line-up :mode org-agenda-mode org-agenda-drag-line-backward)
(meta-defun meta-move-line-down :mode org-agenda-mode org-agenda-drag-line-forward)
(meta-defun meta-move-element-up :mode org-struct-mode org-shiftmetaup)
(meta-defun meta-move-element-down :mode org-struct-mode org-shiftmetadown)
(meta-defun meta-move-element-left :mode org-struct-mode org-shiftmetaleft)
(meta-defun meta-move-element-right :mode org-struct-mode org-shiftmetaright)
(meta-defun meta-move-line-left :mode org-struct-mode org-metaleft)
(meta-defun meta-move-line-right :mode org-struct-mode org-metaright)
(meta-defun meta-insert-enclosure-new-line :mode org-struct-mode org-insert-heading-respect-content)
(meta-defun meta-insert-active-enclosure-new-line :mode org-struct-mode org-insert-todo-heading-respect-content)
(meta-defun meta-new-line :mode org-struct-mode org-return)
(meta-defun meta-undo :mode org-agenda-mode org-agenda-undo)
;; (meta-defun meta-up :mode org-agenda-mode org-agenda-previous-item)
;; (meta-defun meta-down :mode org-agenda-mode org-agenda-next-item)
(meta-defun meta-up :mode org-agenda-mode org-agenda-previous-line)
(meta-defun meta-down :mode org-agenda-mode org-agenda-next-line)
(meta-defun meta-down :mode org-mode
:cond (and (org-at-heading-p)
(not (org-inlinetask-end-p))
(not (org-invisible-p (line-end-position))))
(let ((hl (org-element-at-point)))
(let ((pos (org-element-property :contents-begin hl)))
(when pos
(setq pos
(cl-loop for el = (org-element-at-point pos)
until (org-invisible-p pos)
until (= pos (point-max))
if (memq (org-element-type el) '(drawer property-drawer planning))
do (if (or (org-invisible-p (org-element-property :contents-begin el))
(eq 'planning (org-element-type el)))
(setq pos (org-element-property :end el))
(cl-return pos))
else return pos)))
(if (not pos)
(next-logical-line)
(goto-char pos)
(unless (or (org-invisible-p (1- pos))
(not (org-with-point-at (1- pos) (looking-at-p "^$"))))
(skip-chars-backward "\n\t ")
(forward-char 1))))))))Boon integration
(add-hook 'org-capture-mode-hook 'boon-insert 'append)Sensitive info
;; (org-babel-load-file "~/PersonalDocuments/emacs-personal.org")
(load "~/PersonalDocuments/emacs-personal.el")Magic - I have no clue why it works
Strange error with w3m-idle-timer
(use-package w3m
:after w3m
:config
(setq w3m-image-no-idle-timer t))Make dired-hide-dotfiles work
;; (use-package dired-hide-dotfiles
;; :config
;; (defun dired-hide-dotfiles--hide ()
;; "Hide all dot-files in the current `dired' buffer."
;; (when dired-hide-dotfiles-mode
;; (dired-mark-files-regexp "^\\." nil 'localname)
;; (dired-do-kill-lines))))Fix eldoc raising error on org src blocks
(defun org-eldoc-documentation-function (&rest _) "")SOMEDAY Prevent some functions from native-compilation
(setq comp-deferred-compilation-deny-list
'("pdf-cache"))- Note taken on [2020-12-10 Thu 21:34]
Report to emacs
Summary of key bindings
Git
Global attributes file
git config --global core.attributesfile ~/.gitattributes*.lisp diff=lisp
*.el diff=lisp
*.org diff=org
Main config
[2020-11-08 Sun] Added diff handler to name diff chunks by headline in org files [2021-04-01 Thu] Change regexp according to [[id:7512681c13307f3005696422fa21170a171f538f][Protesilaos Stavrou: Coding blog [Protesilaos] (2021) Informative diff hunks for Emacs Lisp and Org]]; add lisp regexp
[user]
email = yantar92@gmail.com
name = Ihor Radchenko
signingkey = 6470762A7DA11D8B
[github]
user = yantar92
[commit]
gpgsign = true
[merge]
conflictstyle = diff3
[format]
thread = true
[diff "lisp"]
xfuncname = "^(((;;;+ )|\\(|([ \t]+\\(((cl-|el-patch-)?def(un|var|macro|method|custom)|gb/))).*)$"
[diff "org"]
xfuncname = "^(\\*+ +.*)$"
[core]
attributesfile = /home/yantar92/.gitattributes
Rebase by default for new tracking branches
When doing feature development, it makes little sense to merge the feature branch to master explicitly using separate commit. It is better to use rebase instead of merge commit, as recommended in [[id:Stack_Overflow_autos_vs_autosb9a][[Stack Overflow] autosetuprebase vs autosetupmerge]].
[branch]
autosetupmerge = always
autosetuprebase = always
Mpv
:header-args+: :tangle noMain config
:header-args+: :tangle ~/.config/mpv/mpv.confGeneral
Open window without waiting for video to load (relevant when opening online videos on high-ping connection). Do not auto-play for the same reason - sometimes I need to wait for a quite a long time and suddenly playing video would be a surprise.
force-window=immediate
pause # no autoplay
Save position
save-position-on-quit
Initial window placement: center
geometry=1440x900+50%+50%
Save screenshots in PNG format into Downloads folder for further refiling.
screenshot-format=png
screenshot-template='~/Downloads/%F (%P) %n'
keepaspect-window=no
loop-playlist=yes
msg-module # prepend module name to log messages
msg-color # color log messages on terminal
term-osd-bar # display a progress bar on the terminal
keep-open # keep the player open when a file's end is reached
Cache
I prefer huge cache to preload online videos if possible. Connection is not always stable.
cache=yes
cache-secs=1800 # how many seconds of audio/video to prefetch if the cache is active
Subtitles
Automatically detect subtitle file
sub-use-margins
sub-auto=fuzzy # external subs don't have to match the file name exactly to autoload
sub-file-paths=ass:srt:sub:subs:subtitles # search for external subs in the listed subdirectories
embeddedfonts=yes # use embedded fonts for SSA/ASS subs
sub-fix-timing=no # do not try to fix gaps (which might make it worse in some cases)
# the following options only apply to subtitles without own styling (i.e. not ASS but e.g. SRT)
sub-font="Helvetica"
sub-font-size=36
sub-color="#FFFFFFFF"
sub-border-color="#FF262626"
sub-border-size=3.2
sub-shadow-offset=1
sub-shadow-color="#33000000"
sub-spacing=0.5
Languages
slang=enm,en,eng,ru # automatically select these subtitles (decreasing priority)
alang=enm,en,ang,ru # automatically select these audio tracks (decreasing priority)
Audio
af=scaletempo=speed=tempo:stride=30
audio-file-auto=fuzzy # external audio doesn't have to match the file name exactly to autoload
Protocols
yt-dlp
script-opts=ytdl_hook-ytdl_path=/usr/bin/yt-dlp
ytdl-raw-options=format="[protocol!=http_dash_segments][protocol!=rtmp]",all-subs=,mark-watched=,no-check-certificate=
ytdl-format=bestvideo[height<=1080][vcodec=vp9][fps>=60]+bestaudio/bestvideo[height<=1080][vcodec=vp9]+bestaudio/bestvideo[height<=1080]+bestaudio/best[height<=1080]/best
[360p]
ytdl-format=bestvideo[height<=360][vcodec=vp9]+bestaudio/bestvideo[height<=360]+bestaudio/best[height<=360]/best
[480p]
ytdl-format=bestvideo[height<=480][vcodec=vp9]+bestaudio/bestvideo[height<=480]+bestaudio/best[height<=480]/best
[720p]
ytdl-format=bestvideo[height<=720][vcodec=vp9][fps>=60]+bestaudio/bestvideo[height<=720][vcodec=vp9]+bestaudio/bestvideo[height<=720]+bestaudio/best[height<=720]/best
[protocol.https]
user-agent='Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:47.0) Gecko/20100101 Firefox/47.0'
[protocol.http]
user-agent='Mozilla/5.0 (Macintosh; Intel Mac OS X 10.11; rv:47.0) Gecko/20100101 Firefox/47.0'
[extension.gif]
cache=no
no-pause
loop-file=yes
Key bindings
:header-args+: :header-args+: :tangle ~/.config/mpv/input.confctrl+q quit
q ignore
User-scripts
YouTube
Change quality
SOMEDAY save repo separatelyENDC-f to call menu.
https://github.com/jgreco/mpv-youtube-quality
cat $file<<get-file()>># KEY BINDINGS
# invoke or dismiss the quality menu
toggle_menu_binding=ctrl+f
# move the menu cursor up
up_binding=Alt+k
# move the menu cursor down
down_binding=Alt+j
# select menu entry
select_binding=Ctrl+j
# formatting / cursors
selected_and_active=▶ -
selected_and_inactive=● -
unselected_and_active=▷ -
unselected_and_inactive=○ -
# font size scales by window, if false requires larger font and padding sizes
scale_playlist_by_window=yes
# playlist ass style overrides inside curly brackets, \keyvalue is one field, extra \ for escape in lua
# example {\\fnUbuntu\\fs10\\b0\\bord1} equals: font=Ubuntu, size=10, bold=no, border=1
# read http://docs.aegisub.org/3.2/ASS_Tags/ for reference of tags
# undeclared tags will use default osd settings
# these styles will be used for the whole playlist. More specific styling will need to be hacked in
#
# (a monospaced font is recommended but not required)
style_ass_tags={\\fnmonospace}
# paddings for top left corner
text_padding_x=5
text_padding_y=5
# how many seconds until the quality menu times out
menu_timeout=10
#use youtube-dl to fetch a list of available formats (overrides quality_strings)
fetch_formats=yes
# list of ytdl-format strings to choose from
quality_strings=[ {"4320p" : "bestvideo[height<=?4320p]+bestaudio/best"}, {"2160p" : "bestvideo[height<=?2160]+bestaudio/best"}, {"1440p" : "bestvideo[height<=?1440]+bestaudio/best"}, {"1080p" : "bestvideo[height<=?1080]+bestaudio/best"}, {"720p" : "bestvideo[height<=?720]+bestaudio/best"}, {"480p" : "bestvideo[height<=?480]+bestaudio/best"}, {"360p" : "bestvideo[height<=?360]+bestaudio/best"}, {"240p" : "bestvideo[height<=?240]+bestaudio/best"}, {"144p" : "bestvideo[height<=?144]+bestaudio/best"} ]
#+RESULTS[33e778796fc04ae9b0a18b218e68bf5c5d3a404d]:
Archived
Search via helm
- Note taken on [2021-09-21 Tue 20:21]
I am not really using it
(use-package helm
:if init-flag
:defer t
:config
(use-package helm-notmuch
:after notmuch
:straight t))auto-save-buffers-enhanced
[2020-09-24 Thu] This does not work well with large org buffers, especially with my config, which is auto-tangled on save.
Better auto save.
(use-package auto-save-buffers-enhanced
:straight t
:config
(auto-save-buffers-enhanced t))Show file changes in the fringe
- Refiled on [2020-09-24 Thu 21:20]
(use-package git-gutter-fringe+
:if init-flag
:straight t
:diminish git-gutter+-mode
:init
(use-package fringe-helper)
:config
(global-git-gutter+-mode))Highlight uncommitted changes in version-controlled files and dirs
- Refiled on [2020-09-24 Thu 21:21]
It slows down large org files though. Not going to use.
(use-package git-gutter-fringe
:if init-flag
:straight t
:init
(setq git-gutter-fr:side 'right-fringe)
:config
(add-hook 'magit-mode-hook #'git-gutter-mode))Execute current buffer (c++,python,bash,…)
- Refiled on [2020-09-24 Thu 21:21]
(use-package quickrun
:if init-flag
:straight t
:bind (
("<f10>" . quickrun)
("<C-XF86Search>" . quickrun-with-arg)
("<C-M-XF86Search>" . quickrun-shell)
("<C-XF86Explorer>" . quickrun-region)
("<C-M-XF86Explorer>" . quickrun-replace-region)
("<f12>" . helm-quickrun)))Wind move
- Refiled on [2020-09-24 Thu 21:21]
(use-package boon
:if init-flag
:config
(bind-keys :map boon-forward-search-map
("j" . windmove-down)
("k" . windmove-up)
("i". windmove-left)
("o" . windmove-right)
("l" . other-window)
:map boon-backward-search-map
("j" . windmove-down)
("k" . windmove-up)
("i". windmove-left)
("o" . windmove-right)
("l" . other-window)))Show recursive directory size
- Refiled on [2020-09-24 Thu 21:21]
(use-package dired-du
:if init-flag
:straight t
:diminish dired-du-mode
:custom
;; human readable size
(dired-du-size-format t))Do not use mouse
- Refiled on [2020-09-24 Thu 21:22]
I can force no mouse in emacs (see emacswiki). Note that it does not interfere with pdf-tools.
(when init-flag
(mouse-avoidance-mode 'banish))Company completion
[2020-09-25 Fri] This prevents completing the account name Source: [[id:github_debanjum_deban_compan_ledger][debanjum [Github] Debanjum Company-Ledger]](use-package company-ledger
:if init-flag
:straight (company-ledger :host github :repo "debanjum/company-ledger")
:after company
:init
(add-to-list 'company-backends 'company-ledger))Never save some buffers
[2020-09-24 Thu] Seems to be fixed I got an issue withorg-src block editing buffers. They are saved
under some weird name beside the actual org file when some command,
saving all the buffers, is executed.
(defvar yant/never-save-buffer-list nil
"The buffers, matching any of the regexps in this list will never be saved.")Warning when I try to send a message mentioning attachments in text, but without actual attachments
[2020-09-26 Sat] Use notmuch built-in system instead(use-package message-attachment-reminder
:if init-flag
:straight t)Preview screenshot on mouse hover
T to start generation
https://github.com/TheAMM/mpv_thumbnail_script
git clone $url
cd mpv_thumbnail_script
make
cp mpv_thumbnail_script_server.lua ~/.config/mpv/scripts/
cp mpv_thumbnail_script_client_osc.lua ~/.config/mpv/scripts/Allow more space for the function name in profiler report
[2021-01-03 Sun] They actually changed it on master Credit: #email -> Alan Mackenzie <acm@muc.de> A tip: how to display longer function names in profiler-report(use-package profiler
:init
(setq profiler-report-cpu-line-format '((70 left)
(14 right ((9 right) (5 right))))))Fixing slow org priority regexp
[2021-03-13 Sat] Should be fixed on master(setq org-priority-regexp "^\\*+.*\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)")Use [[id:Github-dandavison-dandavison-delta-viewer-c9d][dandavison [Github] dandavison/delta: A viewer for git and diff output]] to show diffs
- Note taken on [2021-08-13 Fri 15:09]
Performance is too low on large diffs (like in Org files)
[[id:Github-dandavison-github-dandavison-magit-213][dandavison [Github] dandavison/magit-delta: Use delta (https://github.com/dandavison/delta) when viewing diffs in Magit]]
Gentoo: dev-util/git-delta
(use-package magit-delta
:straight t
:after magit
:hook (magit-mode . magit-delta-mode))Archive logbook
Credit: https://www.reddit.com/r/orgmode/comments/dg43hs/can_i_archive_a_property_drawer/f3frk2n/(defun my/org-archive-delete-logbook ()
(save-excursion
(org-end-of-meta-data)
(let ((elm (org-element-at-point)))
(when (and
(equal (org-element-type elm) 'drawer)
(equal (org-element-property :drawer-name elm) "LOGBOOK"))
(delete-region (org-element-property :begin elm)
(org-element-property :end elm))))))
(defun my/org-archive-without-delete ()
(cl-letf (((symbol-function 'org-cut-subtree) (lambda () nil)))
(org-archive-subtree)))
(defun my/org-archive-logbook ()
(interactive)
(my/org-archive-without-delete)
(my/org-archive-delete-logbook))FAILED Use git for backups: helm-backup
- Note taken on [2021-08-22 Sun 16:38]
I do not like that it is using ediff
(use-package helm-backup
:straight t
:hook (after-save-hook . helm-backup-versioning))FAILED Sorting with dired-quick-sort
- State “FAILED” from [2021-08-27 Fri 21:48]
Does not play well with dired hide dotfiles
(use-package dired-quick-sort
:if init-flag
:straight t
:after diredp
:init
(setq dired-quick-sort-suppress-setup-warning nil)
:config
(dired-quick-sort-setup))org-graph-view
- Note taken on [2021-08-28 Sat 14:06]
Looks cool, but too messy on large complex files
Requires =media-gfx/graphviz=: LaTeX for diagrams
(use-package org-graph-view
:if init-flag
:straight (org-graph-view :host github :repo "alphapapa/org-graph-view"))Integrate languagetool with flycheck
- Note taken on [2021-10-04 Mon 16:56]
This is checking whole buffer - inefficient on large buffers
(use-package flycheck-languagetool
:if init-flag
:straight t
:custom
(flycheck-languagetool-server-jar nil))