- 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]
;; 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@posteo.net")
(setq force-load-messages t)I do not do much programming, but rather use Emacs as knowledge
base management tool. Most of the time, I do not even edit or type
things directly, but read through the files. The main focus of this
setup is org-mode and not as much programming, navigating through text
and not as much editing.
This Emacs configuration allows loading Emacs in both interactive and batch modes. It is controlled by special variable, identifying startup mode:
init-flag- when non-nil, load all the visual packages and options
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.")[2024-02-07 Wed] This is a fairly slow function adding 0.5 sec to my Emacs startup.
Avoid calling it by explicit customization of variables that are
defined by packages at run time using char-displayable-p.
(setq truncate-string-ellipsis "…")
(setq straight-arrow " → ")
(setq helm-candidate-separator "――――――――――――――――――――――――――――――――――――――")
(setq org-agenda-current-time-string "← now ───────────────────────────────────────────────")
(setq org-agenda-time-grid '((daily today require-timed) (800 1000 1200 1400 1600 1800 2000)
" ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄"))
(setq org-agenda-block-separator ?─)
(setq-default display-fill-column-indicator-character ?\u2502)
(setq pdf-view-use-unicode-ligther nil)Defining custom predicates for org-ql is slow because it requires
unconditional byte-compilation. Defer it to after init time.
Every instance of org-ql-defpred in the configuration must set
org-ql-defpred-defer to t.
(use-package org-ql
:defer t
:init
(add-hook
'after-init-hook
(lambda ()
(org-ql--define-normalize-query-fn (reverse org-ql-predicates))
(org-ql--define-query-preamble-fn (reverse org-ql-predicates))
(org-ql--def-query-string-to-sexp-fn (reverse org-ql-predicates)))))The configuration is integrated with my OS setup. (Or rather my OS setup is integrated with this configuration 😂). You can find the public parts of OS setup in system-config.org.
Init-file, which loads this file.
(setq init-flag t)
(load el-file)I run Emacs in server mode - a no-brainer considering how large my org files are.
Load shell variables. This is necessary because I run Emacs from
non-shell environment, via Awesome WM key bindings and .profile is not
loaded.
(call-process-shell-command "source ~/.profile")Ensure one server instance
(when init-flag
(require 'server)
(unless (server-running-p)
(server-start)))Do not show large file warnings for anything ≤100Mb. The default 10Mb is too small for typical pdfs and for my Org files.
(when init-flag
(setq large-file-warning-threshold (* 100 1024 1024)); 100Mb
)Instead of the default emacs package manager, I use straigt.el.
It allows getting packages from github directly, review the new
commits, and easily maintain custom modifications.
First, 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.
(when (and init-flag (display-graphic-p))
(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")))Use develop branch of straight.el. It has bug fixes earlier.
(setq straight-repository-branch "develop")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)))Now, I can setup use-package to simplify subsequent package configuration.
(eval-and-compile (require 'use-package))Add support for :diminish keyword that alters how minor modes are
indicated in the mode line.
(use-package diminish :straight t)The latest version from package repositories may not be compatible with system version of notmuch executable. Ensure build-in version.
;; Just for local Emacs version.
(add-to-list 'load-path "/usr/share/emacs/site-lisp/notmuch")
(straight-use-package '(notmuch :type built-in))Load org to make sure that older 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" :pre-build nil
:fork (:host github :repo "yantar92/org" :branch "feature/org-fold-universal-core")))
(straight-use-package '(org-contrib
:type git :repo "git@git.sr.ht:~bzg/org-contrib"
:local-repo "~/Git/org-contrib"))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.
Keep customisation away from init.el in a separate file. Load the
custom file now, before everything else in the config. This way,
things explicitly set in the config will take priority over
(overwrite) the customization.
(setq custom-file (file-name-concat user-emacs-directory "custom.el"))
(load custom-file)no-littering is a set of package-specific overrides that
- Moves package files to standard directory structure under
.emacs.d. - Renames them to have the owner package name in the name/path.
(use-package no-littering
:demand t
:straight (no-littering :host github :repo "emacscollective/no-littering"
:local-repo "~/Git/no-littering"))Garbage collection algorithm in Emacs is not the most optimal https://emacsconf.org/2023/talks/gc/. I found that Emacs spends over 25% of time doing GC when just moving around the buffer. And a few seconds during loading.
Increase the GC thresholds to 200Mb temporarily during loading (it reduces GC time during init 10x), and increase GC percentage threshold for long-term in-session effect. See Increase the GC thresholds to 200Mb temporarily during loading (it reduces GC time during init 10x), and increase GC percentage threshold for long-term in-session effect. See https://emacsconf.org/2023/talks/gc/ for rationale and statistical data.
;; For IGC branch
(setq igc-step-interval 0.04)
(setq gc-cons-percentage 0.2)
(setq gc-cons-threshold (* 200 1000 1000))
(add-hook
'after-init-hook
(lambda () (setq gc-cons-threshold (* 20 1000 1000))))
(setq garbage-collection-messages nil) ; nil is default, this is just to remind about the optionThe configuration here is only for generic appearance of emacs. The major mode-specific configuration is configured later on per-mode basis.
#modus_themesFor a while, I have been using 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 modus-themes
:straight (modus-themes
:host gitlab
:repo "protesilaos/modus-themes")
:if init-flag
:init
(require 'modus-operandi-theme)
(setq modus-themes-headings '((t regular)))
(setopt modus-themes-common-palette-overrides modus-themes-preset-overrides-faint)
(setopt modus-operandi-tinted-palette-overrides
'((bg-dim "#f2eff3")
(fg-dim "#505050")
(fg-heading-1 "#5317ac")
(bg-hl-line "#e0e0e0")
(fringe unspecified)
(bg-active bg-blue-subtle)
(bg-hover-secondary "#aae59c")))
:config
(modus-themes-load-theme 'modus-operandi-tinted))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.
(when init-flag
(set-face-attribute 'default nil :height 130 :family "Source Code Pro"))[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/
(when init-flag
(set-fontset-font "fontset-default" 'chinese-gbk (font-spec :family "Sarasa Mono hc"))
;; Credit for the suggestion about `face-font-rescale-alist': @viz:okash.it (Matrix)
(push `("Sarasa Mono hc" . ,(/ 16.0 13.0)) face-font-rescale-alist)
(set-fontset-font "fontset-default" 'cyrillic-iso8859-5 (font-spec :family "source code pro"))
(mapc (lambda (char)
(set-fontset-font "fontset-default" char (font-spec :family "Symbola")))
'(?⏩ ?⛔ ?⌛ ?👨 ?🔗 ?💡 ?🔁 ?🧠)))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 message probably only makes sense for someone who is not yet familiar enough with emacs. Disabling.
(when init-flag (setq inhibit-startup-message t))General frame appearance configuration.
First, disable unnecessary graphical elements No tool bar, no scroll bar, no menu bar (not recommended for newcomers).
(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.
(when init-flag (setq frame-resize-pixelwise t))General settings for window appearance.
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.
Emacs provides a flexible system to control where and how the windows
are displayed - display-buffer-alist.
Understanding how to set display-buffer-alist is not intuitive,
unfortunately. After digging the documentation it is making a lot of
sense though. I also recommend [[id:demystifying-emacss-window-manager-6a0][[Mastering Emacs] Demystifying Emacs’s
Window Manager]].
Since Emacs got native compilation, it really sped things up. However, the way native compilation handles files is different from the earlier approach to compilation - the files are compiled individually, in isolated Emacs processes. This approach revealed a number of inconsistencies across Emacs packages, spitting a crap tone of warnings into users.
Until third-party package manage to get rid (or even address!) the
warnings, the *Warnings* buffer popup remains annoying, especially
when one upgrades packages frequently.
Force warnings buffer to show up at the bottom of the frame, without replacing any existing windows (a very annoying default behavior, especially when some package is native-compiled lazily in the middle of Emacs session).
(when init-flag
(setf (alist-get (regexp-quote "*Warnings*") display-buffer-alist nil nil #'equal)
'(display-buffer-in-side-window (side . bottom) (window-height . 0.3))))(when init-flag
(use-package posframe
:straight t
:config
(defun yant/display-buffer-in-posframe (buffer alist)
"Display BUFFER using `posframe-show'.
ALIST may have non-standard elements `poshandler', `foreground-color',
`background-color', `internal-border-color', and
`internal-border-width' to be passed to `posframe-show'."
(posframe-show
buffer
:override-parameters `((quit-restore . (frame frame nil ,buffer)))
:poshandler (alist-get 'poshandler alist)
:foreground-color (alist-get 'foreground-color alist)
:background-color (alist-get 'background-color alist)
:internal-border-color (alist-get 'internal-border-color alist)
:internal-border-width (alist-get 'internal-border-width alist))
;; FIXME: suppress `org-fit-window-to-buffer'.
(setq-local window-size-fixed t))
(setf (alist-get (regexp-quote "*Select Link*") display-buffer-alist nil nil #'equal)
`(yant/display-buffer-in-posframe
(poshandler . posframe-poshandler-frame-center)
(foreground-color . ,(face-foreground 'mode-line))
(background-color . ,(face-background 'highlight))
(internal-border-color . ,(face-background 'highlight))
(internal-border-width . 20)))))(when init-flag
(setf (alist-get (regexp-opt '("*Async Shell Command*" "*Shell Command Output*")) display-buffer-alist nil nil #'equal)
'(display-buffer-in-side-window (side . bottom) (window-height . 0.15))))- Refiled on [2019-12-25 Wed 14:15]
My screen is too wide to read text comfortably.
I am not very comfortable with auto-fill-mode, so I prefer to limit the buffer width.
olivetti mode is minor-mode and thus it is less intrusive in
comparison with Centered window mode (major mode).
(use-package olivetti
:if init-flag
:straight t
:demand t
:hook ((text-mode notmuch-show-mode erc-mode Info-mode) . olivetti-mode)
:init
(setq-default olivetti-body-width 110)
(defun yant/set-olivetti-width ()
(cond
((derived-mode-p 'Info-mode)
(setq-local olivetti-body-width nil))))
(add-hook 'olivetti-mode-hook #'yant/set-olivetti-width)
(setq olivetti-lighter
(concat " "
(propertize (all-the-icons-material "tablet")
'face `((:family "Material Icons")))))
(use-package boon
:defer t
:config
(bind-keys :map boon-x-map ("w" . olivetti-mode)))
:config
;; Do not shadow cdlatex.
(unbind-key "C-c {" olivetti-mode-map))- Note taken on [2020-08-20 Thu 18:04]
Does not work without fringe - Refiled on [2019-12-25 Wed 14:15]
When the buffer text takes less space then a window, it’s neat to see the beginning/end of the buffer in emacs.
(when init-flag
(setq-default indicate-buffer-boundaries 'left))Match default face background
(when init-flag (set-face-attribute 'fringe nil :background (face-background 'default)))As the usual Emacs user belief goes, fancy “bells and whistles” should be unnecessary. Yet, smooth scrolling makes surprisingly good experience when reading things.
[2025-01-09 Thu] testing ultra-scroll
(use-package pixel-scroll
:if init-flag
:hook
(after-init . pixel-scroll-precision-mode))pixel-scroll-precision-mode only works with mouse and provides scroll-up/down commands.
However, I’d also like recentering window to use smooth scrolling.
(use-package pixel-scroll
:if init-flag
:init
(defun yant/recenter (&optional arg redisplay)
"Like `recenter' but use smooth scroll."
(pcase arg
(`nil
;; Scroll smoothly, with line precision.
(save-excursion
(ignore-errors
(pixel-scroll-precision-interpolate
(* (line-pixel-height)
(- (/ (count-screen-lines (window-start) (window-end)) 2)
(count-screen-lines (window-start) (point))))
nil 1)))
;; Call original recenter for final adjustment.
(recenter arg redisplay))
((pred (not numberp))
(recenter arg redisplay))
((pred (> 0))
;; Scroll smoothly, with line precision.
(save-excursion
(ignore-errors
(pixel-scroll-precision-interpolate
(* (line-pixel-height)
(max 0 (+ (count-screen-lines (point) (window-end)) arg)))
nil 1)))
;; Call original recenter for final adjustment.
(recenter arg redisplay))
((pred (<= 0))
;; Scroll smoothly, with line precision.
(save-excursion
(ignore-errors
(pixel-scroll-precision-interpolate
(* -1 (line-pixel-height)
(max 0 (- (count-screen-lines (window-start) (point)) arg)))
nil 1)))
;; Call original recenter for final adjustment.
(recenter arg redisplay))))
(defun yant/recenter-top-bottom-pixel (&optional arg)
"Like `recenter-top-bottom' but use smooth scrolling."
(interactive "P")
(cond
(arg (yant/recenter arg t)) ; Always respect ARG.
(t
(setq recenter-last-op
(if (eq this-command last-command)
(car (or (cdr (member recenter-last-op recenter-positions))
recenter-positions))
(car recenter-positions)))
(let ((this-scroll-margin
(min (max 0 scroll-margin)
(truncate (/ (window-body-height) 4.0)))))
(cond ((eq recenter-last-op 'middle)
(yant/recenter nil t))
((eq recenter-last-op 'top)
(yant/recenter this-scroll-margin t))
((eq recenter-last-op 'bottom)
(yant/recenter (min -2 (- -1 this-scroll-margin)) t))
((integerp recenter-last-op)
(yant/recenter recenter-last-op t))
((floatp recenter-last-op)
(yant/recenter (round (* recenter-last-op (window-height))) t))))))))Use smooth page-up/down, but do it quickly to not trade visuals for work efficiency.
(use-package pixel-scroll
:if init-flag
:init
(setq pixel-scroll-precision-interpolate-page t
pixel-scroll-precision-interpolation-total-time 0.07))(use-package ultra-scroll
:straight (ultra-scroll :host github :repo "jdtsmith/ultra-scroll")
:init
(setq scroll-conservatively 101 ; important!
scroll-margin 0)
:config
(ultra-scroll-mode 1))General buffer appearance.
- 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 specific 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 (adaprive-wrap package; not yet part of Emacs, but will likely be https://yhetil.org/emacs-devel/878r4eqjh8.fsf@yahoo.com/).
(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))Prefer UTF.
;; English is the default, but still keeping it here to remember that such thing exists.
(set-language-environment "English")
(prefer-coding-system 'utf-8)
;; Automatic detection somehow does not work for some of my files
(add-to-list 'file-coding-system-alist '("\\.org" utf-8))This looks nicer. credit: Xah Lee
The downside is that images created with insert-sliced-image will not be continuous.
(setq-default line-spacing 0.15)Show some text in buffer differently.
(use-package page-break-lines
:if init-flag
:straight t
:diminish page-break-lines-mode
:config (global-page-break-lines-mode))- 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))
))))(when init-flag
(custom-set-faces '(secondary-selection ((t (:background "DarkSeaGreen3"))))))(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"))))Credit: rougier/elegant-emacs: A very minimal but elegant emacs (I think)
(when init-flag
(setq widget-image-enable nil))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))Light face for header line.
(use-package faces
:if init-flag
:if (display-graphic-p)
:after boon
:init
(use-package color :demand t)
:config
(set-face-attribute 'header-line nil
:inherit 'fixed-pitch
: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
:inherit 'fixed-pitch
: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
:inherit 'fixed-pitch
: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)
))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.
Re-write closer to the default mode-lineEND(when init-flag
(defun yant/vc-git-current-branch ()
"Get current GIT branch."
(and vc-mode
(save-match-data
(string-match "Git.\\([^ ]+\\)" vc-mode)
(match-string 1 vc-mode))))
(use-package memoize
:straight t
:demand t
:config
(defmemoize yant/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
(truncate-string-to-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))
?\ ))
(window-total-width)
nil nil t))))))
(setq-default mode-line-format
'((:eval
(yant/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")
" "
(cl-case major-mode
(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 mode-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 (string-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)))
" "))))))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
:config
(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))
)When grepping through sources, I sometimes end up in the middle of a
long unknown function. It is then handy to see what that function is
without having to move the cursor. breadcrumbs package displays
“outline path” to function/variable/place at point in the header line.
(use-package breadcrumb
:if init-flag
:straight t
:defer 5
:config
(breadcrumb-mode +1))(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)))- Refiled on [2019-12-23 Mon 11:43]
(setq multi-message-max 4)
(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 yant/multi-message-list nil)
(defun yant/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 yant/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 yant/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 yant/multi-message-list (cdr yant/multi-message-list)))))
(push (vector (float-time) message (not message-log-max) 1) yant/multi-message-list)
(when (> (length yant/multi-message-list) multi-message-max)
(setf (nthcdr multi-message-max yant/multi-message-list) nil)))
(mapconcat (lambda (m)
(if (= 1 (aref m 3))
(aref m 1)
(concat (aref m 1) (format " (x%d)" (aref m 3)))))
(reverse yant/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 'yant/set-multi-message)(when init-flag
(global-hl-line-mode t))(when init-flag
(set-cursor-color "IndianRed"))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))This section contains customisation relevant to actions associated with running various commands.
Do not use graphical dialogues.
(setq use-dialog-box nil)Disable tooltips.
(tooltip-mode -1)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.
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-down "Scroll down." pixel-scroll-interpolate-up)
(meta-defun meta-scroll-up "Scroll up." pixel-scroll-interpolate-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." yant/recenter-top-bottom-pixel)
(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
'( ediff-mode notmuch-message-mode eshell-mode
shell-mode calc-mode
term-mode vterm-mode
magit-popup-mode)
"List of major modes started with insert state active.")
(use-package org
:defer t
:config
(add-hook 'org-log-buffer-setup-hook (lambda () (boon-set-state 'boon-insert-state))))
(add-to-list 'boon-insert-conditions
'(member major-mode boon-insert-state-major-mode-list))
(use-package boon-qwerty)
(boon-mode))Hydra is useful to quickly run commands in special contexts. It can be
treated as a combination of command mode in boon 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)(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))(when init-flag
(unbind-key "M-u" global-map)
(unbind-key "M-k" global-map)
(unbind-key "M-j" global-map))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+)(when init-flag
(bind-key* "C-S-g" #'exit-recursive-edit))Use text-mode by default. From https://github.com/cadadr/configuration/blob/master/emacs.d/init.el
The default mode is useful when I need to create temporary buffers. For example, when working with logs copied from clipboard.
;; Default mode is ‘text-mode’. The actual default,
;; ‘fundamental-mode’ is rather useless.
(setq-default major-mode 'text-mode)Completion is what makes working in Emacs look like magic.
The default completion is helpful, but it requires not only remembering the keywords used in various function and symbol names, but also the exact order how they appear.
orderless lifts this restriction, allowing to type space-separated
parts of keywords in any order, providing much more pleasant experience.
To illustrate, consider some especially cryptic name like
org-element--cache-avoid-synchronous-headline-re-parsing.
With default completion, one would need to type
org-ele<tab>--cache-avoid-sync<tab>-...
in exact order, while orderless allows simply
org pars cache
(use-package orderless
:straight t
:init
(setq completion-styles '(orderless flex basic)
completion-category-defaults nil
completion-category-overrides '((file (styles partial-completion)))))Because orderless is so efficient in reducing the number of keys
required to find the exact match, it becomes critical to avoid any
additional key stokes that assign completion.
mct package makes the completions buffer pop up automatically, without
a need to type <TAB> or <SPC>.
(use-package mct
:if init-flag
:straight t
:custom
(mct-hide-completion-mode-line t) ; do not display mode line, making completion appear right above minibuffer
(mct-live-update-delay 0.1) ; pop up faster
(mct-completion-passlist '(file buffer consult-buffer org-tag)) ; popup even without typing a few chars
:config (mct-mode +1))By default, pressing space triggers re-computing completions and
causes a delay in live completion buffer updates. With ordeless
completion style, this special behavior is no longer useful. Disable
it.
(use-package orderless
:config
(bind-key "<SPC>" #'self-insert-command minibuffer-local-completion-map))I am so used to helm behavior, that I feel more comfortable navigating
the completions while staying inside the editable minibuffer.
This requires some customized key bindings.
- Navigate completions using
M-j,M-k,<TAB>(use-package mct :config (bind-key "M-j" #'meta-move-line-down minibuffer-mode-map) (bind-key "M-k" #'meta-move-line-up minibuffer-mode-map) (defun yant/minibuffer-complete-or-select () "Partially complete input or select next completion." (interactive) (let ((minibuffer-string (buffer-string))) (minibuffer-complete) (when (equal (buffer-string) minibuffer-string) (with-minibuffer-completions-window (call-interactively #'next-completion) (run-hooks 'post-command-hook))))) (bind-key "<TAB>" #'yant/minibuffer-complete-or-select minibuffer-local-must-match-map) (bind-key "<TAB>" #'yant/minibuffer-complete-or-select minibuffer-local-map))
- Select first listed completion on
<RET>even when multiple completions match the input(use-package mct :config ;; Indicate the changed behavior by auto-highlighting the first ;; completion. (defun yant/select-first-completion () (let ((completions-window (get-buffer-window "*Completions*" 0))) (when completions-window (with-selected-window completions-window (first-completion) (mct--completions-candidate-highlight))))) (add-hook 'completion-list-mode-hook #'yant/select-first-completion) (defun yant/complete-minibuffer-selection () (interactive) (let ((completions-window (get-buffer-window "*Completions*" 0))) (if completions-window (with-selected-window completions-window (condition-case _ (mct-choose-completion-exit) (error (first-completion) (mct-choose-completion-exit)))) (minibuffer-complete-and-exit)))) (bind-key "<RET>" #'yant/complete-minibuffer-selection minibuffer-local-must-match-map))
- Insert selected completion candidate into minibuffer
(use-package mct :config (defun yant/complete-minibuffer-selection-no-exit () "Insert selected or first completion into minibuffer. When completion window is not displayed, perform partial completion." (interactive) (let ((completions-window (get-buffer-window "*Completions*" 0))) (if completions-window (with-selected-window completions-window (condition-case _ (mct-choose-completion-no-exit) (error (first-completion) (mct-choose-completion-no-exit)))) (minibuffer-complete)))) (bind-key "M-l" #'yant/complete-minibuffer-selection-no-exit minibuffer-local-must-match-map) (bind-key "M-l" #'yant/complete-minibuffer-selection-no-exit minibuffer-local-map))
- Provide command to delete the current segment of multi-stage completion
For example, when completing file name, it is handy to be able to
delete the input up to the parent directory and re-start completing
the file/directory name from there.
(use-package mct :config (defun yant/delete-up-to-completion-boundary () "Delete backwards until reachind completion boundary." (interactive) (when minibuffer-completion-table (let ((boundary (car (completion-boundaries (buffer-string) minibuffer-completion-table minibuffer-completion-predicate (buffer-substring (point) (point-max)))))) (if (>= (1+ boundary) (point)) (progn (delete-char -1) (yant/delete-up-to-completion-boundary)) (delete-region (1+ boundary) (point-max)))))) (bind-key "C-l" #'yant/delete-up-to-completion-boundary minibuffer-local-must-match-map) ;; Remove clash (unbind-key "C-l" mct-minibuffer-local-completion-map))
(use-package mct
:config
(add-hook 'completion-list-mode-hook (lambda () (boon-local-mode -1)) 50)
;; First, force `self-insert-command' to work
(dolist (key (mapcar #'char-to-string (string-to-list "znpghq")))
(define-key completion-list-mode-map key 'self-insert-command))
;; Second, remap `self-insert-command' to custom command.
(defun yant/switch-to-minibuffer-and-self-insert (n &optional c)
"Switch to minibuffer and insert the typed key."
(interactive "p")
(switch-to-minibuffer)
(funcall-interactively #'self-insert-command n c))
(define-key completion-list-mode-map [remap self-insert-command]
#'yant/switch-to-minibuffer-and-self-insert)
(bind-key "M-k" #'meta-move-line-up completion-list-mode-map)
(bind-key "M-j" #'meta-move-line-down completion-list-mode-map)
(bind-key "M-l" #'yant/complete-minibuffer-selection-no-exit completion-list-mode-map))(use-package all-the-icons-completion
:straight t
:if init-flag
:config (all-the-icons-completion-mode t))(when init-flag (setq completions-detailed t))(use-package marginalia
:if init-flag
:straight t
;; Bind `marginalia-cycle' locally in the minibuffer. To make the binding
;; available in the *Completions* buffer, add it to the
;; `completion-list-mode-map'.
:bind (:map minibuffer-local-map
("M-a" . marginalia-cycle))
:init
;; Marginalia must be activated in the :init section of use-package such that
;; the mode gets enabled right away. Note that this forces loading the
;; package.
(marginalia-mode +1))(when init-flag
(defun yant/minibuffer-sort-by-history-then-distance (completions)
"Sort COMPLETIONS by Levenshtein distance to input, then put recent on top.
This function is like `minibuffer-sort-by-history', but sorts by
string distance + `string-lessp' first rather than using only
`string-lessp'."
(let* ((minibuffer-input (when (minibufferp) (minibuffer-contents)))
(to-complete-string
(when minibuffer-input
(substring minibuffer-input
(car (completion-boundaries
minibuffer-input
minibuffer-completion-table nil "")))))
(pre-sorted
(sort completions
:lessp
(if to-complete-string
(lambda (a b)
(let ((distance-a (string-distance to-complete-string a))
(distance-b (string-distance to-complete-string b)))
(or (< distance-a distance-b)
(and (= distance-a distance-b)
(string-lessp a b)))))
#'string-lessp))))
;; The following code is copied from
;; `minibuffer-sort-by-history'.
;;
;; Only use history when it's specific to these completions.
(if (eq minibuffer-history-variable
(default-value minibuffer-history-variable))
pre-sorted
(minibuffer--sort-by-position
(minibuffer--sort-preprocess-history minibuffer-completion-base)
pre-sorted))))
(setq completions-sort #'yant/minibuffer-sort-by-history-then-distance))(use-package consult
:straight t
:config
(use-package mct
:config
(add-hook 'completion-list-mode-hook #'consult-preview-at-point-mode)))corfu provides a popup menu just like company. However, unlike
company, it integrates with built-in completion system. I am able to
use orderless completion style without efforts.
I configure corfu to popup the completion list automatically
(corfu-auto) as I type and do it quickly (corfu-auto-delay +
corfu-auto-prefix), so that I can simply type, for example, beg reg
and get the full completion of region-beginning even when typing fast.
(use-package corfu
:straight t
:diminish (corfu-mode . " ⭿")
:hook ((prog-mode ledger-mode) . corfu-mode)
:custom
(corfu-auto t)
(corfu-auto-delay 0.02)
(corfu-auto-prefix 2)
:config
(bind-keys
:map corfu-map
("M-j" . corfu-next)
("M-k" . corfu-previous)
("RET" . nil)))(use-package corfu
:init
(defun corfu-enable-in-minibuffer ()
"Enable Corfu in the minibuffer."
(when (local-variable-p 'completion-at-point-functions)
;; (setq-local corfu-auto nil) ;; Enable/disable auto completion
(setq-local corfu-echo-delay nil ;; Disable automatic echo and popup
corfu-popupinfo-delay nil)
(corfu-mode 1)))
(add-hook 'minibuffer-setup-hook #'corfu-enable-in-minibuffer))(use-package corfu
:init (use-package corfu-history)
:config
(corfu-history-mode 1)
(savehist-mode 1)
(add-to-list 'savehist-additional-variables 'corfu-history))(use-package orderless
:config
(use-package corfu
:config
(bind-keys :map corfu-map ("SPC" . corfu-insert-separator))))With the default value of corfu-quit-no-match (separator), when I type
something like (buffer-substring, because there are multiple matches
for buffer-substring: buffer-substring and
buffer-substring-no-properties, I keep getting completion for already
written function name. Then, if I keep typing (buffer-substring
(region-, I get “No matches” instead of completion for
region-beginning/end. So, change the default to quit currnet
completion when there are no matches.
(use-package corfu
:custom (corfu-quit-no-match t))Unlike 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
[2024-04-22 Mon] As an experiment, I am switching to consult + mct; although I still prefer some helm commands.
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.
;; Working around https://github.com/emacs-helm/helm/issues/2481
(straight-use-package '(helm-core :type git :host github :repo "emacs-helm/helm" :local-repo "~/Git/helm"))
(use-package helm
:if init-flag
:straight (helm :type git :host github :repo "emacs-helm/helm" :local-repo "~/Git/helm")
:requires boon
:after boon
:bind (
("M-y" . helm-show-kill-ring)
("<f1> b" . helm-descbindings)
("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))
:custom
(helm-M-x-show-short-doc t)
(helm-split-window-inside-p t)
(helm-ff-file-name-history-use-recentf t)
:config
(use-package helm-files
:config
(unbind-key "M-k" helm-find-files-map))
(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)))))(use-package helm
:config
(use-package modus-themes :demand t)
(defun yant/set-modus-overrides ()
(modus-themes-with-colors
(set-face-foreground 'helm-source-header fg-heading-0)
(set-face-background 'helm-source-header 'unspecified)
(set-face-background 'helm-candidate-number 'unspecified)
(set-face-foreground 'helm-candidate-number blue-faint)
(set-face-background 'helm-selection bg-hl-line)))
(yant/set-modus-overrides)
(add-hook 'modus-themes-after-load-theme-hook #'yant/set-modus-overrides))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))(use-package helm
:config
(helm-ff-icon-mode +1))Keeping history of file changes both in short and long term is just like backups. One is already using it or not yet using…
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))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
(use-package no-littering
:demand t
:config
(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
backup-directory-alist `(("." . ,(no-littering-expand-var-file-name "backup")))
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)auto-save-visited-mode saves buffers every five seconds. Frequently
enough to tame my paranoia.
However, I do not want to auto-save email drafts. Mostly because Notmuch lists them immediately in the inbox - something I do not want to dig into.
(use-package no-littering
:demand t
:config
(auto-save-visited-mode +1)
(setq remote-file-name-inhibit-auto-save-visited t)
(defun yant/auto-save-buffer-p ()
"Return non-nil when current buffer should be auto-saved."
(cond
((derived-mode-p 'message-mode) nil)
(t t)))
(setq auto-save-visited-predicate #'yant/auto-save-buffer-p)
(setq auto-save-file-name-transforms `((".*" ,(no-littering-expand-var-file-name "auto-save/") t))))Save virtual buffers (kill ring, etc.)
(when init-flag
(savehist-mode 1))Save and restore scratch buffer as well.
(use-package persistent-scratch
:if init-flag
:straight t
:demand t
:config
(persistent-scratch-autosave-mode 1))Record recently opened files.
helm-mini and consult-buffer list these files alongside open buffers,
making it convenient to select what I have in mind most of the time.
(use-package recentf
:if init-flag
:config (recentf-mode t)
:custom (recentf-max-saved-items 100))Cleaning up recent entries takes some time and adds up to Emacs
startup time. To avoid this, I instead instruct recentf to clean
things up when Emacs is idle.
(use-package recentf
:config
;; Do not use :custom here. Otherwise, automatic cleanup will be
;; called immediately when we set this value (due to :set function
;; of this custom option)
(setq recentf-auto-cleanup 10))Do not display messages about cleaning the recent file list.
(use-package recentf
:config
(defun yant/recentf-cleanup-silent (fun)
"Call `recentf-cleanup' suppressing messages."
(let (message-log-max (inhibit-message t)) (funcall fun)))
(advice-add 'recentf-cleanup :around #'yant/recentf-cleanup-silent))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.
(when init-flag
(global-auto-revert-mode -1)
(diminish 'auto-revert-mode)
(setq auto-revert-verbose nil)
(setq revert-without-query '(".*"))
(bind-key* "M-r" #'revert-buffer))(setq vc-follow-symlinks t)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
:bind (:map boon-x-map
("g" . meta-magit-status)
("G" . magit-dispatch-popup)
("M-g" . magit-file-dispatch))
:init
;; Use built-in transient
(require 'transient)
:config
(use-package meta-functions
:config
(meta-defun meta-magit-status "Open magit status buffer" magit-status)
(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)))(when init-flag
(add-hook 'with-editor-mode-hook #'boon-set-insert-state))The default Magit commit buffer displays many “Contained:” and “Merged:” branches which tend to be numerous if I create separate branch for each submitted patch (which I do, with piem).
(use-package magit
:custom
(magit-revision-insert-related-refs-display-alist
'((contained . nil)
(merged . nil))))Magit is able to provide word-level diff refinement. It is disabled by default though. Enabling.
(use-package magit
: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"))))(use-package magit
:if init-flag
:after magit
:commands magit-list-repositories
:custom
(magit-repository-directories '(("~/Git" . 1)
("~/.emacs.d/straight/repos/" . 1)))
(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))))Org links can point to arbitrary buffers given that an appropriate
Elisp implementation is provided. orgit provides Org links for magit
buffers, including links to specific commits. Handy when using
org-capture where the link to current context is automatically added
in my capture templates.
(use-package magit
:if init-flag
:config
(use-package orgit
:straight t
:custom
(orgit-store-reference t)))- State “TODO” from [2018-07-18 Wed 11:26]
Typos are inevitable. Highlighting typos is crucial.
(use-package jinx
:straight t
:custom
(jinx-languages "en_US uk ru")
:hook ((notmuch-message-mode org-mode text-mode) . jinx-mode)
:bind* (("M-h" . jinx-correct)))[[id:dc748ee50c332dec74bd79083898359f7214692f][languagetool-org [Github] languagetool: Style and Grammar Checker for 25+ Languages]]
(use-package langtool
:straight t
:if init-flag
:init
(setq langtool-bin "languagetool")
(setq langtool-default-language "en-US")
(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"
"EN_UNPAIRED_BRACKETS"
"CONSECUTIVE_SPACES"
))
(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))
[[id:Github-cjl8zf-cjl8zf-langtool-ignore-c3a][cjl8zf [Github] cjl8zf/langtool-ignore-fonts: Force Emacs Langtool to ignore certain fonts. For example, this can be used to prevent langtool from highlighting LaTeX in math-mode.]]
(use-package langtool-ignore-fonts
:straight t
:if init-flag
:after langtool
:config
(dolist (hook '(latex-mode-hook markdown-mode-hook notmuch-message-mode-hook))
(add-hook hook #'langtool-ignore-fonts-minor-mode))
(langtool-ignore-fonts-add
'latex-mode '(font-lock-comment-face
font-latex-math-face font-latex-string-face))
(langtool-ignore-fonts-add 'markdown-mode '(markdown-code-face))
(langtool-ignore-fonts-add
'org-mode '( org-property-value org-block
org-link org-meta-line org-macro
org-code org-verbatim org-special-keyword
org-block-begin-line org-block-end-line))
(langtool-ignore-fonts-add
'notmuch-message-mode
'( message-cited-text-1 message-cited-text-2
message-cited-text-3 message-cited-text-4)))(use-package langtool
:if init-flag
:config
(defvar yant/langtool-check-last-run-time (current-time)
"Last time `yant/langtool-check-current-paragraph' was executed.")
(defvar yant/langtool-check-timeout 10
"Timeout in seconds between Langtool checks.")
(defun yant/langtool-check-current-paragraph ()
"Check current paragraph in Org-mode."
(when (and (eq major-mode 'org-mode)
(> (float-time
(time-since yant/langtool-check-last-run-time))
yant/langtool-check-timeout)
(not langtool-buffer-process))
(let ((element (org-element-at-point)))
(when (memq (org-element-type element) '(paragraph))
(org-with-wide-buffer
(push-mark (org-element-property :post-affiliated element) 'silent 'activate)
(goto-char (org-element-property :end element))
;; Move to the last complete sentence.
(if (search-backward
"\\. "
(org-element-property :post-affiliated element)
t)
(progn
(setq yant/langtool-check-last-run-time (current-time))
(funcall-interactively #'langtool-check))
(deactivate-mark)))))))
(add-hook 'org-mode-hook
(lambda ()
(add-hook 'post-self-insert-hook
#'yant/langtool-check-current-paragraph
nil 'local))))(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)
(save-excursion
(message-goto-body)
(push-mark (point) 'silent 'activate)
(goto-char (point-max))
(langtool-check-buffer))
(while langtool-buffer-process
(sit-for 0.1))
(langtool-correct-buffer))
(add-hook 'message-send-hook #'langtool-check-buffer-ensure))[[id:Github-bnbeckwith-bnbeckwith-writegood-mode-453][bnbeckwith [Github] bnbeckwith/writegood-mode: Minor mode for Emacs to improve English writing]]
This mode is generally less powerful than Language tool, but it allows easy customization of things to highlight - useful to define my personal words to pay attention to.
Note that I write a lot of scientific staff and hence passive voice is hard to avoid. I just disable the passive voice highlights.
(use-package writegood-mode
:straight t
:hook (org-mode . yant/writegood-mode)
:config
(set-face-attribute 'writegood-weasels-face nil :inherit 'modus-themes-lang-note)
(defun yant/writegood-mode (&optional arg)
"Turn on `writegood-mode', but disable passive voice checks."
(writegood-mode +1)
(writegood-passive-voice-turn-off)))[[id:English-Language-Usage-Stack-Exchange-expressing-opinion-to-903][[English Language \& Usage Stack Exchange] Expressing an opinion: to me or for me?]]
(use-package writegood-mode
:config
(defun writegood-weasels-font-lock-keywords ()
`((,(writegood-weasels-font-lock-keywords-regexp)
0 '(face writegood-weasels-face help-echo ,writegood-weasel-words-tooltip) prepend)
("For me,"
0 '(face writegood-weasels-face help-echo "Use \"To me\" instead") prepend)
("Schmidt"
0 '(face writegood-weasels-face help-echo "Use \"Schmid\" instead") prepend)
("is not"
0 '(face writegood-duplicates-face help-echo "Double check if I meant \"is now\"") prepend))))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
:demand t
:straight t
:init
(global-flycheck-mode +1)
(setq flycheck-mode-line-prefix "λ✓")
(setq flycheck-global-modes '(not lisp-interaction-mode))
(add-hook 'org-mode-hook #'yant/flycheck-disable-for-large-files)
:config
(defvar yant/flycheck-file-size-threshold (* 1000 500)
"Maximum file size in bytes where `flycheck-mode' is allowed.")
(defun yant/flycheck-disable-for-large-files ()
"Disable flycheck in large files.
The maximum file size is `yant/flycheck-file-size-threshold'."
(when (> (buffer-size) yant/flycheck-file-size-threshold)
(flycheck-mode -1)))
(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)))))(use-package flycheck
:if init-flag
:custom
(flycheck-emacs-lisp-load-path 'inherit))(use-package highlight-parentheses
:if init-flag
:demand t
:straight t
:diminish highlight-parentheses-mode
:init
(require 'modus-themes)
:custom
(highlight-parentheses-background-colors
`(,(face-background 'modus-themes-intense-red)
,(face-background 'modus-themes-intense-magenta)
,(face-background 'modus-themes-intense-blue)))
:config
(add-hook 'minibuffer-setup-hook #'highlight-parentheses-minibuffer-setup)
(dolist (hook
'( prog-mode-hook helpful-mode-hook
debugger-mode-hook lisp-interaction-mode-hook))
(add-hook hook #'highlight-parentheses-mode)))
(use-package rainbow-delimiters
:if init-flag
:demand t
:straight t
:hook ((prog-mode lisp-interaction-mode) . rainbow-delimiters-mode))(use-package highlight-numbers
:if init-flag
:demand t
:straight t
:hook ((prog-mode lisp-interaction-mode) . highlight-numbers-mode))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
:demand t
:straight t
:diminish easy-escape-minor-mode
:hook ((prog-mode lisp-interaction-mode) . easy-escape-minor-mode))Highlight text matching isearch.
(when init-flag
(setf search-highlight t)
(setf query-replace-highlight t))- 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")
:diminish goggles-mode
:hook ((text-mode prog-mode) . goggles-mode)
:config
(goggles-define replace expand-abbrev))(use-package eval-sexp-fu
:if init-flag
:straight t)(when init-flag (setq next-error-message-highlight t))(use-package colorful-mode
:if init-flag
:straight t
:hook (prog-mode text-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.
[2021-05-26 Wed] outline-minor-mode is better than hideshow for buffer
cycling (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.
(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))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))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))File navigation and search are the most frequent actions for me. Here, I want to make sure that the navigation commands are bound 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
("v" . (lambda () (interactive) (boon-set-state 'boon-insert-state)))
("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))By default, boon tries to be smart and does not preserve state set in
a buffer upon switching from it. The side effect is that switching to
other WM frame triggers return to “natural” (usually, command) state
even if I am in the process of editing something and want to look into
a web page, switching from Emacs temporarily.
Disable this feature.
(use-package boon
:config
(remove-hook 'window-selection-change-functions #'boon-reset-state-for-switchw))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
:init
(require 'meta-functions)
(meta-defun meta-goto-char-timer "Jump to visible char" avy-goto-char-timer)
(meta-defun meta-goto-char "Jump to visible char in line" avy-goto-char-in-line)
:bind ( :map boon-moves-map
("H" . meta-goto-char-timer)
("h" . meta-goto-char)
:map boon-special-map
("H" . meta-goto-char-timer)
("h" . meta-goto-char))
:custom
(avy-timeout-seconds 0.2 "The default is too long.")))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))(use-package isearch
:if init-flag
:custom
(isearch-repeat-on-direction-change t))(use-package el-search
:straight t
:if init-flag)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
(define-advice push-mark (:filter-args (args) disable-message)
"Disable \"Mark set\" message."
(list (car args) t (caddr args))))By default, when using hi-lock commands to highlight occurrences of a regexp/symbol in buffer, hi-lock asks for the face to use for highlighting. I do not care. Just select whatever.
(use-package hi-lock
:if init-flag
:config
(setq hi-lock-auto-select-face t))Use eww for most Urls, except some (like EDX) that do not work well
and that I use frequently. Use Qutebrowser for the websites that
require javascript or complex rendering.
(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 "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))
(browse-url-generic url new-window)
(eww url))))
:custom
(browse-url-browser-function 'yant/browse-url)
(browse-url-generic-program "qutebrowser-call.sh"))Since I have the Org mailing list stored locally, I do not need to open the email threads in browser. Can instead use Notmuch.
(use-package browse-url
:init
(defun yant/browse-url-orgmode-ml (url &optional _)
"Open an orgmode list url using notmuch."
(let ((id (and (or (string-match "^https?://orgmode\\.org/list/\\([^/]+\\)" url)
(string-match "^https?://list\\.orgmode\\.org/\\(?:orgmode/\\)?\\([^/]+\\)" url))
(match-string 1 url))))
(when id
(notmuch-show (format "id:%s" id)))))
:config
(add-to-list 'browse-url-handlers
'("^https?://orgmode\\.org/list/\\([^/]+\\)"
. yant/browse-url-orgmode-ml))
(add-to-list 'browse-url-handlers
'("^https?://list\\.orgmode\\.org/\\(?:orgmode/\\)?\\([^/]+\\)"
. yant/browse-url-orgmode-ml)))Imenu allows navigating through the buffer structure, according to the
major mode.
(use-package imenu
:if init-flag
:config
(use-package consult
:config
(use-package meta-functions :config
(meta-defun meta-goto "Goto place in document." consult-imenu)
(meta-defun meta-goto :mode emacs-lisp-mode
:cond (let ((state (syntax-ppss)))
(and (not (nth 3 state))
(not (nth 4 state))))
:cond (thing-at-point 'symbol)
(let ((pos (point-marker)))
(xref-find-definitions (thing-at-point 'symbol))
(not (eq pos (point))))))))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)))(use-package consult
:if init-flag
:config
:bind (:map boon-forward-search-map
("b" . consult-buffer)
:map boon-backward-search-map
("b" . consult-buffer))
:after boon)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)I often 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))))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)))
(use-package meta-functions
:config
(meta-defun meta-kill-buffer yant/kill-this-buffer)
(bind-key "C-x q" #'meta-kill-buffer)))I use boon, and it frees up M-digit bindings.
So, I re-purpose 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
: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
:straight (emacs-windower :host gitlab :repo "ambrevar/emacs-windower" :local-repo "~/Git/emacs-windower")
:bind ("M-`" . #'windower-toggle-split))Use boon-*-search-map to select windows and C-M-l to cycle current window.
(use-package windmove
:bind (("M-l" . other-window)
:map boon-forward-search-map
("j" . windmove-down)
("k" . windmove-up)
("i" . windmove-left)
("o" . windmove-right)))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)))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))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)))(use-package boon
:if init-flag
:config
(bind-keys :map boon-forward-search-map
("f" . find-file)
:map boon-backward-search-map
("f" . find-file)))- 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)
:map boon-backward-search-map
("M-f" . yt/sudo-find-file))))- 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]
(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))
(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)))(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)))(use-package dired-avfs
:if init-flag
:straight t
:after dired
:init
(start-process "mountavfs" nil "mountavfs"))(use-package dired
:custom (dired-dwim-target t))(use-package dired
:if init-flag
:custom
(dired-clean-confirm-killing-deleted-buffers nil))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
: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)))))
:config
(use-package meta-functions
:config
(meta-defun meta-kill-buffer :mode dired-mode dired-quit-window)))Unselect 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))Using trash is safer.
(use-package dired
:if init-flag
:custom
(delete-by-moving-to-trash t)
(trash-directory "~/tmp/Trash"))(use-package dired-open
:if init-flag
:straight t
:bind (:map dired-mode-map
("<return>" . dired-open-xdg)))(use-package dired-rsync-transient
:straight t
:bind (:map dired-mode-map
("C" . dired-rsync-transient))
:config
(defun yant/dired-rsync-report-success ()
(message "%s" (propertize "rsync finished!" :face '(:color "green"))))
(add-hook 'dired-rsync-success-hook #'yant/dired-rsync-report-success)
(setq-default mode-line-format (append mode-line-format '(dired-rsync-modeline-status))))(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" "odt"))
("Scripts"
(extension "gnuplot" "sh"))
("Data"
(extension "txt" "hys" "xls" "xlsx"))
("Images"
(extension "png" "jpg" "jpeg" "tiff" "tif" "svg"))
("Videos"
(extension "avi" "mpeg" "mp4" "mkv" "webm"))
)))
:hook (dired-mode . dired-filter-group-mode))(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))Additional fontification in dired.
(use-package diredfl
:if init-flag
:straight t
:config
(diredfl-global-mode 1))- 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
"-l --almost-all --human-readable --group-directories-first --no-group"))Do not hide symlink target when hiding details.
(use-package dired
:if init-flag
:hook (dired-mode . dired-hide-details-mode)
:custom
(dired-hide-details-hide-symlink-targets nil)
(dired-hide-details-preserved-columns '(4 5 6 7)))[[id:Github-gromnitsky-gromnitsky-wordnut-emacs-0d0][gromnitsky [Github] gromnitsky/wordnut: Emacs major mode interface to WordNet lexical database]] Requires installed =app-dicts/wordnet= package
Display dictionary when requesting help at point in non-code contexts.
(use-package wordnut
:straight t
:config
(require 'meta-functions)
(meta-defun meta-help "Get help on symbol at point." (wordnut-search (word-at-point)))
(meta-defun meta-help
:mode org-mode
:cond
(progn
(and
(not (memq (org-element-type (org-element-at-point)) '(src-block)))
(not (memq (org-element-type (org-element-context)) '(code)))))
(wordnut-search (word-at-point))))- Refiled on [2020-05-12 Tue 15:22]
- State “CANCELLED” from “TODO” [2020-04-09 Thu 17:22]
I do not use bookmarks frequently, but they come handy when I need to visually mark places in a buffer I am reviewing to come back a short while later.
I do not use built-in bookmarks in favor of bm package. Mostly
because bm provides a number of convenience commands:
- Toggling bookmark at point.
- Display bookmarks just in current buffer.
- Separate from built-in bookmark system that is used by some packages to bookmark some places automatically.
(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)))(when init-flag
(setq select-enable-primary t)
(setq save-interprogram-paste-before-kill t))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))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))))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) move-to-beg-first)
(beginning-of-line)))- 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))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))))(when init-flag
(bind-key* "C-<tab>" 'indent-region))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)))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)))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))Meta-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))))(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))))
(use-package boon))(use-package meta-functions
:config
(require 'mct)
(defun yant/switch-to-completions-top-next ()
"Like `mct-switch-to-completions-top', but never go to selected completion."
(interactive)
(mct-switch-to-completions-top)
(when (<= (overlay-start mct--highlight-overlay) (point) (overlay-end mct--highlight-overlay))
(next-completion 1)))
(meta-defun meta-move-line-down :mode minibuffer-mode yant/switch-to-completions-top-next)
(meta-defun meta-move-line-down :mode completion-list-mode mct-next-completion-or-mini)
(defun yant/switch-to-completions-bottom-previous ()
"Like `mct-switch-to-completions-bottom', but never go to selected completion."
(interactive)
(mct-switch-to-completions-bottom)
(when (<= (overlay-start mct--highlight-overlay) (point) (overlay-end mct--highlight-overlay))
(previous-completion 1)))
(meta-defun meta-move-line-up :mode completion-list-mode mct-previous-completion-or-mini)
(meta-defun meta-move-line-up :mode minibuffer-mode yant/switch-to-completions-bottom-previous))Yasnippet is a very handy way to use templates as you type.
There is also built-in skeleton mode, but yasnippet allows more visual
interactive editing style without prompts.
(use-package yasnippet
:if init-flag
:straight t
:hook ((org-mode latex-mode markdown-mode prog-mode lisp-interaction-mode) . yas-minor-mode)
:config
(bind-key "M-<tab>" #'yas-expand yas-minor-mode-map)
(yas-reload-all))[[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))# -*- mode: snippet -*-
# name: LaTeX equation
# key: <eq
# --
\begin{equation}
$0
\end{equation}
(use-package yasnippet-snippets
:if init-flag
:after yasnippet
:straight t)[[id:Github_casouricasour_vundo_visual_undo_treeb21][casouri [Github] casouri/vundo: Visualize the undo tree.]]
(use-package vundo
:if init-flag
:straight t
:demand meta-functions
:bind
("C-x u" . vundo)
:custom
(vundo-glyph-alist vundo-unicode-symbols)
:config
(meta-defun meta-backward :mode vundo-mode vundo-backward)
(meta-defun meta-forward :mode vundo-mode vundo-forward)
(meta-defun meta-down :mode vundo-mode vundo-down)
(meta-defun meta-up :mode vundo-mode vundo-up))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))))(use-package scratch
:if init-flag
:straight t
:bind ("C-c s" . scratch))- 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
"No action defined for this context; try another location"
"Ement: Not connected. Use ‘ement-connect’ to connect"
"Viewing span is already"
"No links on this page"
"pdf-info-epdfinfo-program is not executable"
"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"
"Unknown selector"
"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 attachment directory exist"
"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")))(use-package debug
:if init-flag
:config
(bind-key "s" #'debugger-continue debugger-mode-map))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 keyboard-quit-context+))
(ding))))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))Sometimes, I just need to have any random text in buffer for testing.
(use-package lorem-ipsum
:if init-flag
:straight t)- Refiled on [2020-04-27 Mon 15:06]
(use-package bug-hunter
:if init-flag
:straight t)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"))Finally, he also has a useful interactive tool to display refontification process [[id:Github-lindydancer-lindydancer-highlight-refontification-ac8][Lindydancer [Github] Lindydancer/highlight-refontification: Visualize how font-lock refontifies a buffer]]
(use-package highlight-refontification
:if init-flag
:straight (highlight-refontification :type git :host github :repo "Lindydancer/highlight-refontification"))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"))(use-package macrostep
:if init-flag
:straight t)#inspector
(use-package inspector
:if init-flag
:straight (inspector :host github :repo "mmontone/emacs-inspector")
:config
(defun yant/eval-or-display (oldfun arg)
"Run OLDFUN or display result.
With `\\[universal-argument]', run `inspector-inspect-last-sexp'."
(interactive "P")
(pcase arg
('(4) (inspector-inspect-last-sexp))
(_ (call-interactively oldfun)))))(use-package inspector
:if init-flag
:config
(defun yant/eval-expression-or-display (oldfun arg)
"Run OLDFUN or display result.
With `\\[universal-argument]', run `inspector-inspect-expression'."
(interactive "P")
(pcase arg
('(4) (call-interactively #'inspector-inspect-expression))
(_ (call-interactively oldfun))))
(advice-add 'eval-expression :around #'yant/eval-expression-or-display))(use-package backtrace
:if init-flag
:config
(use-package inspector
:config
(defun yant/backtrace-toggle-locals-dwim (&optional all)
"Toggle locals or inspect return value."
(interactive "P")
(cond
((save-excursion
(beginning-of-line)
(looking-at-p "Debugger entered--returning value:"))
(inspector-inspect-debugger-return-value))
(t (funcall-interactively #'backtrace-toggle-locals all))))
(bind-key "v" #'yant/backtrace-toggle-locals-dwim debugger-mode-map)))(use-package inspector
:if init-flag
:config
(meta-defun meta-up-element :mode inspector-mode inspector-pop))(use-package skeletor
:if init-flag
:straight t
:custom
(skeletor-completing-read-function #'completing-read)
(skeletor-project-directory "~/Git"))There are multiple ways Emacs can assist on getting documentation.
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
Add extra helm-info-at-point sources.
(use-package helm-info
:config
(setq helm-info-default-sources
(append helm-info-default-sources
'(helm-source-info-use-package))))Add command searching across Emacs-related user manuals.
(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))))Add binding to search Elisp libraries.
(bind-key "<f1> l" #'find-library)elisp 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"))
:config
;; Work around Emacs bug#58558.
(setq-default parse-sexp-lookup-properties nil))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))I prefer seeing the actual customization variable names to be set manually here (in this config) myself.
(if init-flag (setopt custom-unlispify-tag-names nil))(use-package which-key
:if init-flag
:diminish which-key-mode
:config
(which-key-mode))(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)))(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)))(use-package helm-info
:after helm
:config
(use-package boon
:if init-flag
:config
(meta-defun meta-help
:mode org-mode
:cond
(or (org-in-src-block-p)
(eq 'code (org-element-type (org-element-context))))
helpful-at-point)
(meta-defun meta-help :mode emacs-lisp-mode helpful-at-point)
(meta-defun meta-help :mode emacs-lisp-compilation-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-at-point)
("h e" . helm-info-emacs-and-extra)
("h o" . helm-info-org)
("h t" . helm-info-texinfo))))(use-package python
:if init-flag
:custom
(python-indent-guess-indent-offset-verbose nil))(use-package eglot
:if init-flag
:config (add-hook 'python-mode-hook #'eglot-ensure))This is according to Corfu README.
(use-package eglot
:config
(use-package corfu
:config
(setq completion-category-overrides
'((eglot (styles orderless))
(eglot-capf (styles orderless))))
;; As per readme
(straight-use-package 'cape)
(advice-add 'eglot-completion-at-point :around #'cape-wrap-buster)));; (use-package auto-virtualenv
;; :if init-flag
;; :straight t
;; :custom (auto-virtualenv-verbose t)
;; :config (add-hook 'python-mode-hook 'auto-virtualenv-set-virtualenv))
(use-package pet
:straight t
:config
;; FIXME: Report upstream?
(defun yant/disable-pet-flycheck-project-root-override ()
"Disable `pet-mode' advicing `flycheck-python-find-project-root'.
This is necessary when virtual environment file is not the same with
git repo."
(advice-remove 'flycheck-python-find-project-root #'pet-flycheck-python-find-project-root-advice))
(add-hook 'python-base-mode-hook #'pet-mode -10)
(add-hook 'pet-mode-hook #'yant/disable-pet-flycheck-project-root-override))(use-package eglot
:if init-flag
:bind (:map eglot-mode-map
("C-c C-d" . eldoc)
("C-c C-e" . eglot-rename)
("C-c C-f" . eglot-format-buffer)))- [2024-12-30 Mon] Use
pyrightlanguage server- Unlike
pylsp, it can do static typechecking and thus method completion in class variables
- Unlike
(use-package eglot
:if init-flag
:config
(setq-default
eglot-workspace-configuration
'(:pyright
(:plugins
(;; Note autopep uses some pycodestyle settings further down to avoid redefining things namely aggressive, exclude, hangClosing, ignore, maxLineLength and select
:autopep8 (:enabled t)
:flake8
( :config nil ; string: null (default)
:enabled :json-false ; boolean: true or false (default)
:exclude [] ; string array: [] (default)
:executable "flake8" ; string: "flake8" (default)
:extendIgnore [] ; string array: [] (default)
:filename nil ; string: null (default)
:hangClosing nil ; boolean: true or false; null (default)
:ignore [] ; string array: [] (default)
:indentSize nil ; integer: null (default)
:maxComplexity 15 ; integer: null (default)
:maxLineLength nil ; integer: null (default)
:perFileIgnores [] ; string array: [] (default) e.g. ["file_path.py:W305,W304"]
:select nil) ; string array: null (default)
:jedi
( :auto_import_modules ["numpy" "pymatgen" "matplotlib" "numpy"] ; string array: ["numpy"] (default)
:env_vars nil ; object: null (default)
:environment nil ; string: null (default)
:extra_paths []) ; string array: [] (default)
:jedi_completion
( :cache_for ["pandas" "numpy" "tensorflow" "matplotlib" "pymatgen"]
:eager t ; boolean: true or false (default)
:enabled t ; boolean: true (default) or false
:fuzzy :json-false ; boolean: true or false (default)
:include_class_objects t ; boolean: true or false (default)
:include_function_objects t ; boolean: true or false (default)
:include_params t ; boolean: true (default) or false
:resolve_at_most 50) ; integer: 25 (default)
:jedi_definition
( :enabled t ; boolean: true (default) or false
:follow_builtin_definitions t ; boolean: true (default) or false
:follow_builtin_imports t ; boolean: true (default) or false
:follow_imports t) ; boolean: true (default) or false
:jedi_references
(:enabled t)
;; FIXME: errs
;; :jedi_signature_help
;; (:enabled t)
:jedi_symbols
( :all_scopes t
:enabled t
:include_import_symbols t)
:mccabe
( :enabled t ; boolean: true (default) or false
:threshold 15) ; integer: 15 (default)
:preload
( :enabled t ; boolean: true (default) or false
:modules []) ; string array: [] (default)
:pycodestyle
( :enabled t ; boolean: true (default) or false
:exclude [] ; string array: [] (default)
:filename [] ; string array: [] (default)
:hangClosing nil ; boolean: true or false; null (default)
:ignore [] ; string array: [] (default)
:indentSize nil ; integer: null (default)
:maxLineLength nil ; integer: null (default)
:select nil) ; string array: null (default)
:pydocstyle
( :addIgnore [] ; string array: [] (default)
:addSelect [] ; string array: [] (default)
:convention nil ; string: "google", "numpy" or "pep257"; null (default)
:enabled :json-false ; boolean: true or false (default)
:ignore [] ; string array: [] (default)
:match "(?!test_).*\\.py" ; string: "(?!test_).*\\.py" (default)
:matchDir "[^\\.].*" ; string: "[^\\.].*" (default)
:select nil) ; string array: null (default)
:pyflakes
(:enabled t) ; boolean: true (default) or false
:pylint
( :args [] ; string array: [] (default)
:enabled :json-false ; boolean: true or false (default)
:executable nil) ; string: null (default)
:rope_autoimport
( :code_actions (:enabled t) ; boolean: true (default) or false
:completions (:enabled t) ; boolean: true (default) or false
:enabled :json-false ; boolean: true or false (default)
:memory :json-false) ; boolean: true or false (default)
:rope_completion
( :eager :json-false ; boolean: true or false (default)
:enabled :json-false) ; boolean: true or false (default)
:yapf
(:enabled t))))))I usually use aggressive-indent-mode for auto-indentation, but for
Python specifically it often annoyingly re-indents unrelated code
after expressions. Disable.
(use-package aggressive-indent
:if init-flag
:defer t
:config
(defun yant/disable-aggressive-indent ()
(aggressive-indent-mode -1))
(add-hook 'python-mode-hook #'yant/disable-aggressive-indent))(use-package meta-functions
:if init-flag
:after python
:config
(meta-defun meta-new-line :mode inferior-python-mode comint-send-input))(when init-flag
(setq fill-column 80)
(dolist (hook '(emacs-lisp-mode-hook lisp-interaction-mode-hook))
(add-hook hook #'display-fill-column-indicator-mode)))- Refiled on [2020-04-23 Thu 14:42]
Smarter elisp editing. (not enough said, but one just has to try for a few days first)
(use-package paredit
:if init-flag
:straight t
:demand t ;; I need it in scratch buffer
:hook ((lisp-mode lisp-interaction-mode emacs-lisp-mode) . paredit-mode)
:config
;; Fix hooks being added too late for scratch buffer.
(add-hook 'after-init-hook (lambda () (run-mode-hooks 'lisp-interaction-mode-hook)))
(use-package boon
:defer t
:after meta-functions
:config
(unbind-key "<RET>" paredit-mode-map)
(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)
(meta-defun meta-cut-element :cond paredit-mode paredit-kill)
(bind-keys :map boon-insert-map
("M-o" . meta-move-line-right)
("M-i" . meta-move-line-left))))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))(use-package eros
:if init-flag
:straight t
:hook ((lisp-mode lisp-interaction-mode emacs-lisp-mode) . eros-mode)
:config
(use-package inspector
:config
(advice-add 'eros-eval-last-sexp :around #'yant/eval-or-display)))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)(use-package regexp-disasm
:if init-flag
:straight (regexp-disasm :host github :repo "mattiase/regexp-disasm"))(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))(use-package gnuplot
:if init-flag
:straight t
:mode ("\\.\\(gp\\|gnuplot\\|plot\\)$" . gnuplot-mode))(use-package lua-mode
:if init-flag
:straight t)(use-package ebuild-mode
:if init-flag
:straight t)(use-package info-colors
:if init-flag
:straight t
:init
(add-hook 'Info-selection-hook 'info-colors-fontify-node))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.
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))(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))Finance tracking. The Emacs config is coupled with finance modeline indicators that keep me informed about my budget status - Continuous monitoring of budget.
(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 yant/ledger-file))
(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 Opening")
("balsg" "ledger --pedantic -f %(ledger-file) bal not Opening -X SGD")
("balusd" "ledger --pedantic -f %(ledger-file) bal not Opening -X $")
("baleur" "ledger --pedantic -f %(ledger-file) bal not Opening -X EUR")
("balcny" "ledger --pedantic -f %(ledger-file) bal not Opening -X CNY")
("baltry" "ledger --pedantic -f %(ledger-file) bal not Opening -X TRY")
("balall" "ledger --pedantic -f %(ledger-file) bal not Opening")
("reg" "ledger --pedantic --pending -f %(ledger-file) reg not Opening")
("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)))(when init-flag
(add-hook 'ledger-mode-hook (lambda () (setq-local pcomplete-termination-string ""))))(use-package ledger-mode
:if init-flag
:defer t
:config
(setq ledger-complete-in-steps t))(use-package wolfram-mode
:if init-flag
:straight t)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"(use-package pdf-tools
:if init-flag
:straight t
:magic ("%PDF" . pdf-view-mode)
:init
:config
(pdf-tools-install))(use-package pdf-tools
:if init-flag
: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 (&optional n)
"Go down document in pdf-view."
(interactive)
(let ((image-roll-step-size (or n 10)))
(pdf-view-next-line-or-next-page (or n 10))))
(defun yant/pdf-view-up (&optional n)
"Go up document in pdf-view."
(interactive)
(let ((image-roll-step-size (or n 10)))
(pdf-view-previous-line-or-previous-page (or n 10))))
:config
(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-down-element :mode pdf-view-mode pdf-view-next-page)
(meta-defun meta-up-element :mode pdf-view-mode pdf-view-previous-page)
(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-up :mode pdf-view-mode (yant/pdf-view-down 20))
(meta-defun meta-scroll-down :mode pdf-view-mode (yant/pdf-view-up 20))
;; (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)))(use-package pdf-tools
:if init-flag
:config
(add-hook 'pdf-view-mode-hook #'pdf-view-fit-width-to-window 'append))Enable goodies like isearch support, link selection, jump history, etc (see pdf-tools-enabled-modes).
(use-package pdf-tools
:if init-flag
:config
(add-hook 'pdf-view-mode-hook #'pdf-tools-enable-minor-modes 'append))(use-package pdf-tools
:if init-flag
:config
(require 'meta-functions)
(meta-defun meta-goto-char :mode pdf-view-mode pdf-links-action-perform))Use code from https://github.com/dalanicolai/dala-emacs-lisp/blob/master/pdf-avy-highlight.el
(use-package pdf-tools
:if init-flag
:config
(defcustom pdf-links-convert-pointsize-scale 0.02
"The scale factor for the -pointsize convert command.
This determines the relative size of the font, when interactively
reading links."
:group 'pdf-links
:type '(restricted-sexp :match-alternatives
((lambda (x) (and (numberp x)
(<= x 1)
(>= x 0))))))
(defun pdf-links-read-char-action (query prompt)
"Using PROMPT, interactively read a link-action.
BORROWED FROM `pdf-links-read-link-action'.
See `pdf-links-action-perform' for the interface."
(pdf-util-assert-pdf-window)
(let* ((links (pdf-info-search-string
query
(pdf-view-current-page)
(current-buffer)))
(keys (pdf-links-read-link-action--create-keys
(length links)))
(key-strings (mapcar (apply-partially 'apply 'string)
keys))
(alist (cl-mapcar 'cons keys links))
(size (pdf-view-image-size))
(colors (pdf-util-face-colors
'pdf-links-read-link pdf-view-dark-minor-mode))
(args (list
:foreground (car colors)
:background "blue"
:formats
`((?c . ,(lambda (_edges) (pop key-strings)))
(?P . ,(number-to-string
(max 1 (* (cdr size)
pdf-links-convert-pointsize-scale)))))
:commands pdf-links-read-link-convert-commands
:apply (pdf-util-scale-relative-to-pixel
(mapcar (lambda (l) (car (cdr (assq 'edges l))))
links)))))
(print colors)
(unless links
(error "No links on this page"))
(unwind-protect
(let ((image-data nil))
(unless image-data
(setq image-data (apply 'pdf-util-convert-page args ))
(pdf-cache-put-image
(pdf-view-current-page)
(car size) image-data 'pdf-links-read-link-action))
(pdf-view-display-image
(create-image image-data (pdf-view-image-type) t)
(pdf-view-current-page))
(pdf-links-read-link-action--read-chars prompt alist))
(pdf-view-redisplay))))
(defun avy-timed-input ()
"BORROWED FORM `avy--read-candidates'"
(let ((str "")
char break)
(while (and (not break)
(setq char
(read-char (format "char%s (prefer multiple chars w.r.t. speed): "
(if (string= str "")
str
(format " (%s)" str)))
t
(and (not (string= str ""))
avy-timeout-seconds))))
;; Unhighlight
(cond
;; Handle RET
((= char 13)
(if avy-enter-times-out
(setq break t)
(setq str (concat str (list ?\n)))))
;; Handle C-h, DEL
((memq char avy-del-last-char-by)
(let ((l (length str)))
(when (>= l 1)
(setq str (substring str 0 (1- l))))))
;; Handle ESC
((= char 27)
(keyboard-quit))
(t
(setq str (concat str (list char))))))
(print str)))
(defun pdf-keyboard-get-coordinates (end)
(let* ((query (avy-timed-input))
(coords (list (or (pdf-links-read-char-action query "Please specify (SPC scrolls): ")
(error "No char selected")))))
;; (print coords)
;; (print (car (alist-get 'edges (car coords))))))
(car (alist-get 'edges (car coords)))))
(defun pdf-keyboard-highlight (&optional arg)
"Highlight text selecting region via avy.
When called with \\[universal-argumen], add text annotation instead."
(interactive "P")
(let* ((start (pdf-keyboard-get-coordinates nil))
(end (unless arg (pdf-keyboard-get-coordinates t)))
(edges (unless arg (append (cl-subseq start 0 2) (cl-subseq end 2 4)))))
(if arg
(progn
;; Move to margins
(let* ((target (if (< (car start) 0.5) 0.01 0.95))
(shift (- (car start) target)))
(setq start
(pcase-let ((`(,x1 ,y1 ,x2 ,y2) start))
(list (- x1 shift) y1 (- x2 shift) y2))))
(pdf-annot-add-annotation
'text
start
(pdf-annot-merge-alists
(cdr (assq 'text pdf-annot-default-annotation-properties))
(cdr (assq t pdf-annot-default-annotation-properties))
`((color . ,(car pdf-annot-color-history))))))
(pdf-annot-add-markup-annotation
edges 'highlight '"yellow")) nil)))
(use-package pdf-tools
:if init-flag
:config
(require 'meta-functions)
(meta-defun meta-goto-char-timer :mode pdf-view-mode pdf-keyboard-highlight))(use-package pdf-annot
:defer t
:init
(setq pdf-annot-list-format '((page . 3)
(type . 10)
(label . 24)
(date . 24)
(contents . 24))))(use-package pdf-view-restore
:if init-flag
:straight t
:after pdf-tools
:config
(add-hook 'pdf-view-mode-hook 'pdf-view-restore-mode))(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))))Requires app-text/diffpdf.
(use-package diffpdf
:if init-flag
:straight t)It is really good, actually - see [[id:Emacsconf-emacsconf-2022-talks-99a][[Emacsconf] EmacsConf - 2022 - talks - Top 10 reasons why you should be using Eshell]]
(use-package eat
:if init-flag
:straight t
:init
(add-hook 'eshell-load-hook #'eat-eshell-mode))
(use-package eshell
:if init-flag
:bind ("<f9>" . eshell)
:after meta-functions
:config
(meta-defun meta-new-line :mode eshell-mode eshell-send-input))(use-package eat
:if init-flag
:custom
;; xterm makes programs use colors, but not the default value (no idea why)
(eat-term-name "xterm"))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)
:custom
(vterm-timer-delay 0.01))
;; ;; 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))))(use-package eterm-256color
:if init-flag
:straight t
:hook
(term-mode-hook . eterm-256color-mode)
(vterm-mode-hook . eterm-256color-mode))(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))(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)))
(use-package calc
:if init-flag
:bind (:map boon-goto-map
("c" . calc)
("C" . calc-dispatch)))(setq calc-symbolic-mode t)(use-package calc
:if init-flag
:config
(setq calc-gnuplot-default-device "qt"))(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 customization 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")))(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))(use-package yaml-mode
:if init-flag
:straight t)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))Record the screen cast 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.
[2022-01-22 Sat] Disabling keycast because it is not working with my heavily customized mode line.
(use-package tb-keycast
:if init-flag
:if (display-graphic-p)
:straight (tb-keycast :host github :repo "ir33k/tb-keycast"
:fork (:host github :repo "yantar92/tb-keycast")
:local-repo "~/Git/tb-keycast")
:config
(setq-default tab-bar-format nil)
(setq tb-keycast-align-right-p t)
(set-face-attribute 'tab-bar nil
:inherit 'default
:underline (color-lighten-name (face-foreground 'default) 80)
:height 1.0))
;; (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"))(use-package qrencode
:if init-flag
:commands (qrencode-region qrencode-url-at-point)
:straight (qrencode-el :host github :repo "ruediger/qrencode-el"))(use-package graphviz-dot-mode
:straight t
:init
(setf (alist-get "dot" org-src-lang-modes nil nil #'string=) 'graphviz-dot))
(use-package elfeed
:if init-flag
:straight t
:bind (:map elfeed-search-mode-map
("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 -war -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)))))))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
`(("@[^ \n]+" "@⣀")
("\\\\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")
("<mtext>\\(.*?\\)</mtext>" "\\1")
("<mn>\\(.*?\\)</mn>" "\\1")
("<br>\\(.*?\\)</br>" "\\1")
("<mo>\\(.*?\\)</mo>" "\\1")
("<p>\\(.*?\\)</p>" "\\1")
("<code>\\(.*?\\)</code>" "\\1")
("<span[^>]*>\\(.*?\\)</span>" "\\1")
("<radio[^>]*>\\(.*?\\)</radio>" " \\1")
("<br[^>]*>" " ")
("<hr[^>]*>" " ")
("<span>\\(.*?\\)</span>" "\\1")
("<a[^>]*>\\(.*?\\)</a>" "\\1")
("<strong>\\(.*?\\)</strong>" "\\1")
("<mi[^>]*>\\(.*?\\)</mi>" "\\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)))
("<span[^>]*>\\(.+?\\)</span>" "\\1")
("<span[^>]*>" "")
("<img[^>]*>" "")
("<a[^>]+>" "")
("<ul>" "")
("<li>" "")
("{\\([^}]+\\)}" "\\1")
("slid[^ ]+" "\\&" (face (:foreground "red")))
("geolog[^ ]+" "\\&" (face (:foreground "red")))
("[Rr]eview" "\\&" (face (:foreground "red" :background "yellow")))
("[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")))
("[Bb]i-?crystals?" "\\&" (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")))
("[Bb]ayesian" "\\&" (face (:foreground "red")))
("[dD]islocation" "\\&" (face (:foreground "red")))
("[Mm]agnesium" "\\&" (face (:foreground "red")))
("[Mm]g" "\\&" (face (:foreground "red")))
("[Cc]rack[^ ]*" "\\&" (face (:foreground "red")))
("\\(#[^#[:space:]]+\\)\\([:space:]+#[^#[:space:]]+\\)+" "\\1᳟")
("\\(?:https?://www\\.\\|https?://\\|www\\.\\)\\([^/ \n]+\\)[^ \n]*" "\\&"
( eval .
(list 'display
(format "%s᳟↗"
(let ((str (match-string 0)))
(string-match "\\(?:https?://www\\.\\|https?://\\|www\\.\\)\\([^/ \n]+\\)[^ \n]*" str)
(match-string 1 str))))))
(" +" " "))
"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 (or (elfeed-meta entry :elfeed-score/score) elfeed-score-scoring-default-score))
(title (if (elfeed-tagged-p 'content_is_entry entry)
(or (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)
t
;; (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)
(if (eq (car-safe display) 'eval)
(eval (cdr display))
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))
(use-package elfeed
:if init-flag
:if (display-graphic-p)
: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)))))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
: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))) (sit-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))))- multiple accounts
(setq send-mail-function 'sendmail-send-it) (setq notmuch-identities '("Ihor Radchenko <yantar92@posteo.net>" "Ihor Radchenko <ihor.radchenko@ensemble3.eu>" "Ihor Radchenko <yantar92@gmail.com>" "Ihor Radchenko <ihor_radchenko@alumni.sutd.edu.sg>")) ;;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@posteo.net" from) "yantar92@posteo.net") ((string-match "yantar92@gmail.com" from) "yantar92@gmail.com") ((string-match "ihor_radchenko@alumni.sutd.edu.sg" from) "ihor_radchenko@alumni.sutd.edu.sg") ((string-match "ihor.radchenko@ensemble3.eu" from) "ihor.radchenko@ensemble3.eu")))) (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") ("yantar92@posteo.net" . "Posteo/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" "yantar92@posteo.net" "ihor.radchenko@ensemble3.eu") "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)
(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))(use-package notmuch
:if init-flag
:defer t
: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" "+todo"))))(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).")
(define-advice notmuch-refresh-this-buffer (:around (fun &rest args) update-notmuch-frame)
"Preserve `notmuch-frame' value after refresh."
(let ((notmuch-frame-old notmuch-frame))
(apply fun args)
(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))text/html; qutebrowser-call.sh %s
text/*; xdg-open "%s"
application/*; xdg-open "%s"
video/*; xdg-open "%s"
image/*; xdg-open "%s"
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/"
: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)))(use-package org-capture-ref
:if init-flag
:load-path "~/Git/org-capture-ref/"
:init
(use-package persid
:straight (persid :host github :repo "rougier/persid"))
: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))- State “TODO” from [2018-09-06 Thu 10:11]
(use-package footnote
:if init-flag
:hook (message-mode . footnote-mode)
:init
(setq footnote-prefix [(control ?c) ?f]))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 "notmuch-addrlookup"))(use-package message
:custom-face
(notmuch-message-summary-face ((t (:foreground ,(face-foreground 'header-line))))))(use-package notmuch
:if init-flag
:defer t
:config
(use-package notmuch-calendar-x
:straight (notmuch-calendar-x :local-repo "~/Git/notmuch-calendar-x")))Use different signatures depending on the sent address.
(when init-flag
;; "@\\(debbugs\\.\\)?gnu.org\\|@github.com"
(defvar yant/message-signature-alist `(("yantar92@posteo\.net" . "Ihor Radchenko // yantar92,
Org mode maintainer,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
")))
(defun yant/message-signature ()
"Insert signature depending on the addressee."
(save-excursion
(save-restriction
(widen)
(message-goto-body)
(narrow-to-region (point-min) (point))
(catch :done
(dolist (pair yant/message-signature-alist)
(goto-char (point-min))
(when (re-search-forward (car pair) nil t)
(throw :done (cdr pair))))))))
(setq message-signature '(yant/message-signature)))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))(use-package notmuch
:if init-flag
:defer t
:config
(add-hook 'notmuch-mua-send-hook #'notmuch-mua-attachment-check))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))(use-package notmuch
:if init-flag
:defer t
:config
(defun yant/notmuch-show-check-cc-and-reply (&optional prompt-for-sender)
"Remind to CC orgmode."
(interactive "P")
(when (member "emacs-orgmode.gnu.org" (notmuch-show-get-tags))
(let ((case-fold-search t))
(save-excursion
(goto-char (point-min))
(unless (re-search-forward "^\\(To:\\|Cc:\\).+emacs-orgmode@gnu\\.org" nil t)
(unless (yes-or-no-p "Org mode ML is not in CC. Send anyway? ")
(error "Org mode ML is not in CC"))))))
(notmuch-show-reply prompt-for-sender))
(bind-key "R" #'yant/notmuch-show-check-cc-and-reply notmuch-show-mode-map))(setq message-dont-reply-to-names `("noreply"
"builds@sr.ht"
,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))(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 "Learn more here:")
(let ((inhibit-read-only t))
(with-silent-modifications
(add-face-text-property beg (match-beginning 0)
'(face (:weight bold))))))))))))
(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)
(re-search-forward "^$")
(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)
(if (eq (car-safe display) 'eval)
(eval (cdr display))
display))))))))))
(add-hook 'notmuch-show-hook #'yant/notmuch-show-fontify-semanticscholar-email)
(add-hook 'notmuch-show-hook #'yant/notmuch-show-fontify-keywords))We usually check contribution status in https://orgmode.org/worg/contributors.html
However, this is manual and get annoying quickly.
I automated the check by examining WORG repository directly and checking the git log in Org repo.
(when init-flag
(defvar yant/org-devel-committers-cache nil
"String holding all the committers.")
(defvar yant/org-devel-committers-stats nil
"Hash table holding committer stats.")
(defvar yant/org-devel-committers-cache-update-time nil
"Last time `yant/org-devel-committers-cache' was refreshed.")
(defvar yant/org-devel-committers-cache-update-interval (* 60 60 24)
"Frequency of updating `yant/org-devel-committers-cache'.")
(defcustom yant/org-devel-committer-aliases
'(("Max Nikulin" . "Maxim Nikulin")
("Mikhail Skorzhinskiy" . "Mikhail Skorzhinskii")
("David Lukeš" . "David Lukes")
;; typo
("Mikhail Skorzhisnkii" . "Mikhail Skorzhinskii")
("mskorzhinskiy@eml.cc" . "mskorzhinskii@eml.cc")
("Juan Manuel Macías" . "Juan Manuel Macias")
("András Simonyi" . "Andras Simonyi")
("emacs@vergauwen.me" . "Bob Vergauwen")
("dmg@turingmachine.org" . "Daniel M German")
("gerard.vermeulen@posteo.net" . "Gerard Vermeulen")
("Fraga, Eric" . "Eric S.\\nbsp{}Fraga")
("Christopher M. Miles" . "stardiviner")
("matt@excalamus.com" . "Matthew Trzcinski"))
"Alist storing aliases for known contributor names.")
(defun yant/org-devel-get-notmuch-sender-FSF-status (sender)
"Retrieve FSF assignment status of SENDER."
(let (email
end-of-FSF-assign
committer-stats
(all-committers yant/org-devel-committers-cache)
(case-fold-search t))
(if (not (string-match " *\\(.+?\\) *<\\([^@>]+@[^>]+\\)>" sender))
(progn
(setq email sender)
(setq sender (alist-get sender yant/org-devel-committer-aliases sender nil #'equal)))
(setq email (match-string 2 sender))
(setq sender (match-string 1 sender))
;; Avoid too short names.
(unless sender (setq sender email))
(when (length< sender 5) (setq sender email))
(setq email (alist-get email yant/org-devel-committer-aliases email nil #'equal))
(setq sender (alist-get sender yant/org-devel-committer-aliases sender nil #'equal)))
(if (not email)
(propertize
"Contributor status unknown"
'face 'modus-themes-refine-red)
(when (or (not all-committers)
(not yant/org-devel-committers-cache-update-time)
(> (float-time
(time-since
yant/org-devel-committers-cache-update-time))
yant/org-devel-committers-cache-update-interval))
(setq yant/org-devel-committers-cache
(concat
(shell-command-to-string
"cd ~/Git/org-mode/; PAGER=\"cat\"; git log --format='%aN %aE' | uniq")
;; (shell-command-to-string
;; "cd ~/Git/emacs/; PAGER=\"cat\"; git log --format='%aN %aE' | uniq")
)
all-committers yant/org-devel-committers-cache
yant/org-devel-committers-stats (make-hash-table :test #'equal)
yant/org-devel-committers-cache-update-time (current-time)))
(when (or (string-match-p email all-committers)
(string-match-p sender all-committers))
(unless (gethash email yant/org-devel-committers-stats)
(puthash
email
(concat
(shell-command-to-string
(format "cd ~/Git/org-mode/; git log --author=\"%s\" --pretty=tformat: --numstat main | gawk '{ add += $1; subs += $2; loc += $1 - $2 } END { printf \"+l: %%s -l: %%s total: %%s\", add, subs, loc }' -"
(downcase (if (string-match-p email all-committers)
email sender))))
"; commits: "
(shell-command-to-string
(format "cd ~/Git/org-mode/; git log --author=\"%s\" --pretty=oneline main | wc -l"
(downcase (if (string-match-p email all-committers)
email sender))))
;; " | Emacs: "
;; (shell-command-to-string
;; (format "cd ~/Git/emacs/; git log --author=\"%s\" --pretty=tformat: --numstat master | gawk '{ add += $1; subs += $2; loc += $1 - $2 } END { printf \"+l: %%s -l: %%s total: %%s\", add, subs, loc }' -"
;; (downcase (if (string-match-p email all-committers)
;; email sender))))
;; "; commits: "
;; (shell-command-to-string
;; (format "cd ~/Git/emacs/; git log --author=\"%s\" --pretty=oneline master | wc -l"
;; (downcase (if (string-match-p email all-committers)
;; email sender))))
)
yant/org-devel-committers-stats)))
(catch :exit
(with-current-buffer (get-buffer-create " *Org FSF data*")
(when (= 0 (buffer-size))
(insert-file-contents "~/Git/worg/contributors.org"))
(goto-char (point-min))
(search-forward "Current contributors with FSF assignment")
(save-excursion
(search-forward "Processing")
(setq end-of-FSF-assign (point)))
(when (search-forward sender end-of-FSF-assign t)
(throw
:exit
(propertize
(string-trim (concat "FSF assignment done; " (gethash email yant/org-devel-committers-stats)))
'face 'modus-themes-intense-green)))
(save-excursion
(search-forward "Current contributors with tiny changes")
(setq end-of-FSF-assign (point)))
(when (search-forward sender end-of-FSF-assign t)
(throw
:exit
(propertize
(string-trim (concat "FSF assignment pending; " (gethash email yant/org-devel-committers-stats)))
'face 'modus-themes-nuanced-red)))
(when (or (string-match-p sender all-committers)
(string-match-p sender email))
(throw
:exit
(propertize
(concat "Tiny change contributor; " (gethash email yant/org-devel-committers-stats))
'face 'modus-themes-intense-yellow))))
(propertize
"Contributor status unknown"
'face 'modus-themes-intense-red)))))
(defvar yant/org-devel-ml-stats nil
"Hash table holding Org mailing list participant stats.")
(defun yant/org-devel-get-notmuch-sender-ML-status (sender)
"Retrieve Org mailing list participation status of SENDER."
(let (first-mention email-count email)
(setq sender (string-trim sender))
(setq email sender)
(when (string-match " *\\(.+?\\) *<\\([^@>]+@[^>]+\\)>" sender)
(setq email (match-string 2 sender))
;; Avoid too short names.
(unless (length< sender 5)
(setq sender (match-string 1 sender))))
(if (and (hash-table-p yant/org-devel-ml-stats)
(gethash sender yant/org-devel-ml-stats)
(< (float-time (time-since (nth 0 (gethash sender yant/org-devel-ml-stats))))
yant/org-devel-committers-cache-update-interval))
(setq first-mention (nth 1 (gethash sender yant/org-devel-ml-stats))
email-count (nth 2 (gethash sender yant/org-devel-ml-stats)))
(unless (hash-table-p yant/org-devel-ml-stats)
(setq yant/org-devel-ml-stats (make-hash-table :test #'equal)))
(setq first-mention
(plist-get
(car (read
(shell-command-to-string
(format
"notmuch search --format=sexp --sort=oldest-first --limit 1 date:2000.. and \\(tag:deleted or not tag:deleted\\) and tag:emacs-orgmode.gnu.org and \\(from:\"%s\" or from \"%s\"\\)"
sender email))))
:date_relative))
(setq email-count
(string-trim-right
(shell-command-to-string
(format
"notmuch count date:2000.. and \\(tag:deleted or not tag:deleted\\) and tag:emacs-orgmode.gnu.org and \\(from:\"%s\" or from \"%s\"\\)"
sender email))))
(puthash sender (list (current-time) first-mention email-count) yant/org-devel-ml-stats))
(propertize
(format "In Org ML since %s (%s messages)" first-mention email-count)
'face 'modus-themes-mark-alt)))
(defvar yant/org-devel-maintainer-stats nil
"Hash table holding Org maintainer stats.")
(defun yant/org-devel-get-maintainer-status (sender)
"Retrieve Org maintainer status of SENDER."
(let (email maintained-files)
(setq sender (string-trim sender))
(setq email sender)
(when (string-match " *\\(.+?\\) *<\\([^@>]+@[^>]+\\)>" sender)
(setq email (match-string 2 sender))
;; Avoid too short names.
(unless (length< sender 5)
(setq sender (match-string 1 sender))))
(if (and (hash-table-p yant/org-devel-maintainer-stats)
(gethash sender yant/org-devel-maintainer-stats)
(< (float-time (time-since (nth 0 (gethash sender yant/org-devel-maintainer-stats))))
yant/org-devel-committers-cache-update-interval))
(setq maintained-files (cdr (gethash sender yant/org-devel-maintainer-stats)))
(unless (hash-table-p yant/org-devel-maintainer-stats)
(setq yant/org-devel-maintainer-stats (make-hash-table :test #'equal)))
(setq maintained-files nil)
(with-current-buffer (get-buffer-create " *Org maintainer data*")
(when (= 0 (buffer-size))
(let ((default-directory "~/Git/org-mode/"))
(shell-command
"ag Maintainer:"
(current-buffer))))
(goto-char (point-min))
(while (or (search-forward sender nil t)
(search-forward email nil t))
(beginning-of-line 1)
(when (looking-at "^\\(.+\\):[0-9]+:;;")
(push (match-string 1) maintained-files))
(beginning-of-line 2)))
(puthash sender (cons (current-time) maintained-files) yant/org-devel-maintainer-stats))
(when maintained-files
(propertize
(format "Maintaining: %s" maintained-files)
'face 'region))))
(defun yant/notmuch-show-highlight-contribution-status ()
"Indicate contributor status for Org ML.
This functoin is intended to be used in `notmuch-show-markup-headers-hook`."
(goto-char (point-min))
(let ((indentation
(progn
(looking-at "^ *")
(match-string 0)))
(sender (condition-case nil
(or (notmuch-show-get-header :Reply-To)
(notmuch-show-get-from))
(error
(goto-char (point-min))
(org-with-wide-buffer
(replace-regexp-in-string
" *(.+" ""
(buffer-substring
(line-beginning-position 0)
(line-end-position 0))))))))
(while (looking-at "^ *[A-Za-z][-A-Za-z0-9]*:")
(forward-line))
;; FIXME: when there is a message included inside message, the
;; above code may return message mime name instead of the sender.
(unless (string-match-p "\\[[^]]+\\]" sender)
(when (save-excursion (re-search-backward (regexp-opt '("emacs-orgmode@gnu.org")) nil t))
(put-text-property
(1- (point)) (point)
'display
(concat
"\n"
indentation (yant/org-devel-get-notmuch-sender-FSF-status sender) "\n"
indentation (yant/org-devel-get-notmuch-sender-ML-status sender) "\n"
indentation (yant/org-devel-get-maintainer-status sender) "\n"))))))
(add-hook 'notmuch-show-markup-headers-hook #'yant/notmuch-show-highlight-contribution-status))When reading long and entangled public mailing list threads, many people can participate and it is sometimes difficult to notice emails from important people I know (maintainers, friends, etc). A clear color indication of emails from significant people is helpful in such scenarios.
(use-package notmuch
:if init-flag
:after org-ql
:init
(defun yant/notmuch-show-highlight-contact-info ()
"Overlay contact info for sender.
This functoin is intended to be used in `notmuch-show-markup-headers-hook`."
(goto-char (point-min))
(let ((sender (condition-case nil
(or (notmuch-show-get-header :Reply-To)
(notmuch-show-get-from))
(error
(goto-char (point-min))
(org-with-wide-buffer
(replace-regexp-in-string
" *(.+" ""
(buffer-substring
(line-beginning-position 0)
(line-end-position 0)))))))
name)
(setq name sender)
(when (string-match "\\(.+?\\) *<\\([^ ]+@[^ >]+\\)" sender)
(setq name (match-string 1 sender))
;; Too short names cause false-positive matches.
(when (length< name 6) (setq name sender))
(setq sender (match-string 2 sender)))
(setq name (replace-regexp-in-string " via \"Bug reports for GNU Emacs, the Swiss army knife of text editors\"" "" name))
(let ((contact-title
(car
(org-ql-query
:from "~/Org/contacts.org"
:where `(or (regexp ,sender)
(regexp ,name))
:select
(lambda (el)
(org-element-interpret-data
(org-element-property :title el)))))))
(unless (or (equal user-full-name contact-title) ; do not highlight my own messages.
(equal "builds@sr.ht" sender))
(put-text-property
(point-min) (1+ (point-min))
'display
(concat
(if contact-title
;; Known contact.
(propertize contact-title 'face 'modus-themes-refine-green)
;; Unknown contact
(propertize "--> Unknown contact <--" 'face 'dired-flagged))
"\n"
(or (get-text-property (point-min) 'display)
(buffer-substring (point-min) (1+ (point-min))))))))))
(add-hook 'notmuch-show-markup-headers-hook #'yant/notmuch-show-highlight-contact-info))When discussion goes off-topic on mailing lists, emails are sometimes moved to alternative lists or into a private email. Sometimes, without obvious indication.
Mark mailing lists (and off-list messages) with different colors to make things more noticeable.
(use-package notmuch
:if init-flag
:init
(defun yant/notmuch-show-highlight-mailing-list ()
"Overlay mailing list the message is in.
This functoin is intended to be used in `notmuch-show-markup-headers-hook`."
(goto-char (point-min))
(let ((mailing-lists
(let (lists)
(goto-char (point-min))
(when (save-excursion (search-forward "emacs-orgmode@gnu.org" nil t))
(push (propertize "ML: Org mode" 'face 'modus-themes-subtle-cyan) lists))
(when (save-excursion (search-forward "help-gnu-emacs@gnu.org" nil t))
(push (propertize "ML: Help GNU Emacs" 'face 'modus-themes-subtle-green) lists))
(when (save-excursion (search-forward "emacs-devel@gnu.org" nil t))
(push (propertize "ML: Emacs devel" 'face 'modus-themes-subtle-magenta) lists))
(when (save-excursion (search-forward "emacs-tangents@gnu.org" nil t))
(push (propertize "ML: Emacs tangents" 'face 'modus-themes-intense-yellow) lists))
(when (save-excursion (search-forward "emacs-gc-stats@gnu.org" nil t))
(push (propertize "ML: emacs-gc-stats" 'face 'modus-themes-intense-blue) lists))
(when (save-excursion (search-forward "@debbugs.gnu.org" nil t))
(push (propertize "Debbugs" 'face 'modus-themes-mark-alt) lists))
(when (save-excursion (re-search-forward "\\([^ ]+\\) <[^<@ ]+@noreply\\.github\\.com" nil t))
(push (propertize (format "Github: %s" (match-string 1)) 'face 'modus-themes-intense-magenta) lists))
(when (save-excursion (re-search-forward "\\([^@ ]+\\)@lists\\.sr\\.ht" nil t))
(push (propertize (format "SourceHut: %s" (match-string 1)) 'face 'modus-themes-mark-sel) lists))
lists)))
(put-text-property
(point-min) (1+ (point-min))
'display
(concat
(if mailing-lists
(mapconcat #'identity mailing-lists " ")
(propertize "--> Off list <--" 'face 'dired-flagged))
" "
(or (get-text-property (point-min) 'display)
(buffer-substring (point-min) (1+ (point-min))))))))
(add-hook 'notmuch-show-markup-headers-hook #'yant/notmuch-show-highlight-mailing-list))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")[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
(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
(string-trim-right
(shell-command-to-string (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"))
(string-trim (shell-command-to-string (format "trans -no-warn -b \"%s\"" string))))
(memoize #'yant/translate-string)
(memoize #'yant/guess-language-string)))(use-package erc-hl-nicks
:if init-flag
:straight t)
(use-package erc
:if init-flag
:demand t
:custom
(erc-default-server "chat.sr.ht")
(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-hide-list '("JOIN" "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-timing 'indent)
(erc-autojoin-channels-alist '(("libera.chat" "#org-mode")))
(erc-modules '( autoaway autojoin button completion fill
irccontrols keep-place list match menu
move-to-prompt netsplit networks noncommands
notifications
readonly ring stamp track smiley spelling hl-nicks log))
:config
(defun run-erc ()
(interactive)
(erc-tls :server "chat.sr.ht"
:port 6697
:nick "yantar92"
:user "yantar92/irc.libera.chat" ;; Example with Libera.Chat
:password (erc-auth-source-search :host "chat.sr.ht" :user "yantar92/irc.libera.chat")))
(use-package meta-functions
:config
(meta-defun meta-new-line :mode erc-mode (erc-send-current-line))))(use-package erc
:custom
(erc-save-buffer-on-part t)
(erc-log-write-after-send t)
(erc-log-write-after-insert t)
(erc-log-insert-log-on-open t))Make Emacs ERC automatically re-connect when it looses server connection.
(use-package erc
:if init-flag
:custom
(erc-server-reconnect-attempts t))(setq shell-history-file-name t)(setq remote-file-name-inhibit-locks t)As per tramp#Frequently Asked Questions
(use-package tramp
:config
(setq vc-ignore-dir-regexp
(format "\\(%s\\)\\|\\(%s\\)"
vc-ignore-dir-regexp
tramp-file-name-regexp)))[[id:GitLab-willvaughn-willvaughn-emacs-0x0-d03][willvaughn [GitLab] willvaughn/emacs-0x0: Integration with https://0x0.st from emacs]]
(use-package 0x0
:if init-flag
:straight (0x0 :host gitlab :repo "willvaughn/emacs-0x0")
:config
(defalias 'yant/share-file #'0x0-upload-file)
(defalias 'yant/share-region #'0x0-upload-text))(use-package mastodon
:if init-flag
:straight t
:init
(use-package persist :straight t)
(require 'multisession) ;; FIXME
:custom
(mastodon-instance-url "https://fosstodon.org")
(mastodon-active-user "yantar92")
:config
(meta-defun meta-down-element :mode mastodon-mode mastodon-tl--goto-next-item)
(meta-defun meta-up-element :mode mastodon-mode mastodon-tl--goto-prev-item)
(meta-defun meta-new-line :mode mastodon-mode mastodon-tl--do-link-action-at-point))The built-in mastodon.el heuristics matching URL is not ideal.
Here is a more reliable setup that simply lets eww render the page, looks up if it is mastodon and redirects when it is.
(use-package mastodon
:init
(use-package org-capture-ref :demand t)
(defun yant/open-mastodon-maybe ()
"When current EWW page is mastodon page, open it via mastodon.el."
(when (derived-mode-p 'eww-mode)
(save-excursion
(goto-char (point-min))
(when (let ((html-data (plist-get eww-data :dom)))
(setq org-capture-ref--buffer-dom html-data)
(or (equal "Iceshrimp" (org-capture-ref-query-dom :meta 'application-name))
(org-capture-ref-query-dom :class "app-holder" :id "mastodon")))
(let ((url (plist-get eww-data :url)))
(kill-buffer)
(mastodon-url-lookup url))))))
(add-hook 'eww-after-render-hook #'yant/open-mastodon-maybe))Despite the usual big-tech concerns, it makes a decent:
- Initial guess for searching new topics
- Quick translation of texts to be polished by hand
- Surprisingly good answers in nuanced topics
(use-package gptel
:if init-flag
:straight t
:after boon
:custom
(gptel-api-key (lambda () (nth 0 (process-lines "pass" "show" "internet/openai-key"))))
(gptel-default-mode 'org-mode)
:config
(setf (alist-get 'org-mode gptel-response-prefix-alist)
"# AI response\n")
(dolist (map '(boon-forward-search-map boon-backward-search-map))
(bind-key "q" #'gptel-menu map)))(use-package osm
:if init-flag
:straight t)(use-package osm
:if init-flag
:init
(defun yant/display-all-gpx ()
"Display all my GPX tracks in current OSM buffer."
(when (derived-mode-p 'osm-mode)
(let* ((files (append (directory-files-recursively "~/Sync/GPX" "\\.gpx$")
(directory-files-recursively "~/Sync/GPX2" "\\.gpx$")))
(reporter (progress-reporter-make "Displaying GPX tracks" 0 (length files))))
(cl-loop
for idx = 0 then (cl-incf idx)
for f in
(sort
(append (directory-files-recursively "~/Sync/GPX" "\\.gpx$")
(directory-files-recursively "~/Sync/GPX2" "\\.gpx$"))
:key (lambda (f) (file-attribute-modification-time (file-attributes f)))
:reverse t)
do (progress-reporter-update reporter idx)
;; when (= 0 (% idx 5))
do
;; Suppress refreshing the view while batch-processing
(cl-letf (((symbol-function 'osm--revert) #'ignore)
((symbol-function 'osm--goto) #'ignore))
(osm-gpx-show f))
finally (progress-reporter-done reporter)
finally (osm--revert)
finally return nil))))
(defun yant/display-all-gpx-delayed ()
"Call `yant/display-all-gpx' after delay."
(run-with-timer 2 nil #'yant/display-all-gpx))
(add-hook 'osm-mode-hook #'yant/display-all-gpx-delayed))This config was originally inspired by Bernt Hansen’s config, but have gone a long way since then. Now, includes elements of Zettelkasten, P.A.R.A., and many other task management approaches I have encountered and tried in the past. Everything tailored to my personal needs.
(setq org-element--cache-self-verify 'backtrace
;; record logs, but only check critical crashes
org-element--cache-self-verify-frequency 0.00
org-element--cache-diagnostics-ring-size 50000)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
[2021-01-15 Fri] The ideas part turned out to be quite tricky. In the
past, I kept all the ideas in separate headline. However, practice
showed that I tend to forget checking that long list of the
ideas. This might be solved by reviewing the idea list regularly, but
it is also not practical since the idea lists tend to grow a lot and
require long time to go through. Instead or reviewing all the ideas
together, it would be better to make sure that ideas are reminded to
me from time to time without a need for me to think when is the next
time I want to be reminded. This is similar to tickler list in GTD
[[id:1f151305-2d61-42b9-9438-503c9b538352][Allen David [2015] Getting things done : the art of stress-free
productivity]] managed using org-drill, so that spaced repetition method
is used to find out when to remind about the idea next time.
(setq org-tag-alist
'(("COMMON" . ?c) ("PhD" . ?p) ("INBOX" . ?i) ("TRACK" . ?t)
("BOOKMARK" . ?b) ("NOEXPORT" . ?n) ("NODEADLINE" . ?d)
("SKIP" . ?s) ("SKIP_PROJECT_REVIEW" . ?S) ("NOARCHIVE" . ?a)
("ARCHIVEALL" . ?A) ("ignore" . ?g) ("REFILE" . ?r)
("AREA" . ?E) ("FLAGGED" . ?F) ("@home" . ?h) ("@work" . ?w)
("_hard" . ?x) ("_easy" . ?z) ("meeting" . ?m)))
(setq org-tags-exclude-from-inheritance
'("ATTACH"
"REFILE" "AREA"
"FLAGGED"
"project" "goal"
"SKIP_PROJECT_REVIEW"))_hard- Task needs significant efforts. Useful when I am scanning for things to do with low-energy.
_easy- Task does not require much effort. Useful when I am scanning for things to do with low-energy.
COMMON- General task
PhD- Related to work/PhD
INBOX- Need to be processed (for new captured tasks)
TRACK- The link from this task/item is monitored for changes in the internet. So, I will eventually get reminded automatically to do the task by email, website notification or other means.
BOOKMARK- Contains a link
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. SKIP_PROJECT_REVIEW- Low-importance projects that I do not want to see in the review (limited tracking only when stuck/hold).
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). Setting this tag also moves task attachments to my backup drive.
ARCHIVEALL- Do not archive individual tasks in the subtree. Only do it all together.
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 project- The task is a project
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.
The task is any item with todo keyword, which is not a project.
(use-package org-ql
:defer t
:config
(setq org-ql-defpred-defer t)
(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 (replace-regexp-in-string "\\." "" 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 yant/org-agenda-update-after-tickler-change ()
"Update agenda re-schedule overlay upon tickler change.
To be used in `post-command-hook'."
(unwind-protect
(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)))))))
(remove-hook 'post-command-hook #'yant/org-agenda-update-after-tickler-change)))
(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-hook 'post-command-hook #'yant/org-agenda-update-after-tickler-change)))))
(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.
I use inline tasks to add temporary todo state (instead of notes). It should be removed once done and placed into notes when archiving.
(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)))- State “TODO” from [2018-03-12 Mon 17:59]
Some of the tasks cannot be done until some condition is met. Before
that, it does not make too much sense to show it in agenda. I use
org-edna for managing dependencies. On top of blocked tasks
management, it allows to schedule tasks on trigger. It introduces two
new properties: 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-toggle-tag "TRACK" 'on)
(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) 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))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 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 now 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)The project is an item with todo keyword and subtask.
(use-package org-ql
:defer t
:config
(setq org-ql-defpred-defer t)
(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)
(use-package org-ql
:defer t
:config
(setq org-ql-defpred-defer t)
(org-ql-defpred-alias subtask ()
"A subtask of a project."
(and (or (todo) (done))
(ancestors (project)))))(use-package org-ql
:defer t
:config
(setq org-ql-defpred-defer t)
(org-ql-defpred-alias subproject ()
"Match a subproject."
(and (project)
(not (tags-local "project"))
(ancestors (and (not (area)) (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* ((element (org-element-lineage (org-element-at-point) '(headline inlinetask) t)) (mystate (or (and (fboundp 'org-state) state) (org-element-property :todo-keyword element)))) (when (member mystate '("NEXT" "TODO")) (org-with-wide-buffer (setq element (org-element-property :parent element)) (while (and element (not (eq 'org-data (org-element-type element)))) (when (or (eq (org-element-property :todo-type element) 'done) (and (eq (org-element-property :todo-type element) 'todo) (string= (org-element-property :todo-keyword element) "WAITING"))) (org-with-point-at (org-element-property :begin element) (org-todo "NEXT")) ;; `org-todo' will call us recursively. (setq element nil)) (setq element (org-element-property :parent element))))))) (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)
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.
- inbox.org
- Temporary staging area for fleeting notes and captured tasks
- notes.org
- all kind of generally useful information
(when init-flag (defun notes-open () (interactive) (find-file "~/Org/notes.org")))
- rss.org
- rss entries for Elfeed
- contacts.org
- my contacts
- schedule.org
- appointments
- all of it is in
~/Org/agenda_files
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")))- 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]
(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))Org mode provides attachment: link type to link to files attached to
current heading. However, 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 (split-string ":" arg)))
(file (cadr (split-string ":" arg))))
(concat (file-name-as-directory
(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
(use-package memoize :config (memoize #'yant/process-att-id-abbrev))
(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
(mapconcat
#'identity
(mapcar (lambda (str) (replace-regexp-in-string "/" "\\\\/" str))
(append (list (file-name-nondirectory (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 (mapconcat
#'identity
(mapcar (lambda (str) (replace-regexp-in-string "/" "\\\\/" str))
(append (list (file-name-nondirectory (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 (file-name-as-directory ref-dir)))
(org-file-complete-link)))
(filepath (apply #'s-concat (cdr (split-string ":" 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 (split-string ":" link)))
(file (nth 2 (split-string ":" link))))
(org-with-point-at (org-id-find id 'marker)
(when-let ((heading (org-get-heading 'no-tags 'no-todo 'no-priority 'no-comment)))
(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 (expand-file-name org-attach-id-dir))
(expand-file-name default-directory))
(string-match (concat (regexp-quote (expand-file-name 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
:description #'org-att-id-link-description)
(use-package org-id
:after org)
(setq org-id-method (quote uuidgen))
(setq org-id-link-to-org-use-id 't)(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
:description #'org-id-link-desk)- State “TODO” from [2018-10-23 Tue 21:45]
(setq org-footnote-section nil)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 (mapconcat #'identity (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)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))- 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))(use-package org
:custom
(org-cite-export-processors
'((latex bibtex)
(t basic))))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
;; I do not like this behaviour.
(unbind-key "_" org-cdlatex-mode-map)
(unbind-key "^" org-cdlatex-mode-map))(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 (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." (let* ((ans (org-read-date nil nil nil PROMPT)) (days-from-now (/ (float-time (time-since (org-time-string-to-time ans))) 60 60 24))) (if (or (> days-from-now -30) ; not more than 1 month ahead (yes-or-no-p (format "Really postpone to %s (+%d days)?" ans (- days-from-now)))) ans (user-error "Postponed too far ahead. Aborting")))) (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)))) (cl-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
- 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
:config(add-to-list 'org-use-property-inheritance "DIR")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
(file-name-as-directory 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))The default org-attach-attach function does not allow to attach directories.
I made it so in the interactive specification in Default attachment directory.
- 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
;; (file-name-concat 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
(file-name-concat 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
(file-name-as-directory 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
(file-exists-p dir)
(file-directory-p dir))
(let* ((attach-path dir)
(symlinks-directory
(file-name-as-directory
(file-name-concat
dir
yant/org-attach-symlinks-directory)))
(attachments-symlink-directory
(file-name-as-directory
(file-name-concat
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 (file-regular-p symlinks-directory)
(error (format "File exist in place of dir: %s" symlinks-directory)))
(when (and (file-exists-p attachments-symlink-directory)
(not (file-symlink-p (directory-file-name attachments-symlink-directory))))
(error (format "Not a symlink: %s" attachments-symlink-directory)))
;; update dirs
(unless (file-exists-p symlinks-directory)
(make-directory symlinks-directory))
(unless (or (file-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
;;(debug)
(file-symlink-p attach-path (directory-file-name attachments-symlink-directory)))
(when (and (file-exists-p attachments-symlink-directory)
(not (yant/org-task-has-attachments-p)))
(delete-file (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
(file-name-concat
(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)
(make-directory yant/org-attach-file-symlink-path)))
(directory-file-name
(file-name-concat
(or yant/org-attach-file-symlink-path
default-directory)
entry-name)))))
(if (not (file-exists-p entry-symlink-name))
(progn
;;(debug)
(make-symbolic-link symlinks-directory (directory-file-name entry-symlink-name)))
(unless (file-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)
(seq-filter
#'file-directory-p
(directory-files 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
(file-name-concat 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 (expand-file-name d)))
(when (file-symlink-p (directory-file-name dir))
(delete-directory 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 (file-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
(file-name-concat
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
(file-name-as-directory
(file-name-concat head-path entry-path))))
(file-name-as-directory
(file-name-concat
(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
- State “NEXT” from “TODO” [2018-08-27 Mon 08:39]
- 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)))- 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 (ignore-errors (org-attach-dir t))))))
(or attach-dir-inherited
dir)))
;; (advice-remove 'org-attach-dir #'org-attach-dir@yant/org-attach-use-attach-dir-inheritance))(require 'org-agenda)
(setq org-agenda-skip-scheduled-delay-if-deadline t)
(setq org-agenda-skip-deadline-prewarning-if-scheduled 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-up 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 nil)
(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.
(set-face-attribute 'org-agenda-structure nil
:height 120
:foreground "firebrick")
(set-face-attribute 'org-agenda-date-today nil
:foreground "dark goldenrod")
(setq org-agenda-skip-function nil)
(use-package org-ql
:defer t
:config
(setq org-ql-defpred-defer t)
(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 (("q" "Full agenda"
agenda ""
((org-agenda-tag-filter-preset '("-TICKLER" "-CANCELLED" "-WAITING" "-HOLD" "-SOMEDAY" "-NODEADLINE"))
(org-agenda-regexp-filter-preset '("-TICKLER"))
(org-agenda-span 'week)))
("r" "3 day agenda"
agenda ""
((org-agenda-tag-filter-preset '("-TICKLER" "-CANCELLED" "-WAITING" "-HOLD" "-SOMEDAY" "-NODEADLINE"))
(org-agenda-skip-function '(yant/org-agenda-skip-org-ql
(quote (not (todo "TICKLER" "DOING")))))
(org-agenda-span 3)))
("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-local "SKIP_PROJECT_REVIEW"))
(not (tags "SOMEDAY" "HOLD" "WAITING" "CANCELLED" "NODEADLINE"))
(not (todo "TODO"))
(not (done))
(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
'(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")
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(project))))
(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-local "SKIP_PROJECT_REVIEW"))
(not (tags "CANCELLED" "HOLD"))
(not (area))
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(project)))))
(org-agenda-sorting-strategy
'(priority-down))))
(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-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 "[%(yant/get-clocked-time-today-for-agenda)%e] %-12:c\t%?-12t")
(org-agenda-todo-ignore-scheduled t)
(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 '(yant/org-agenda-skip-org-ql '(not (project))))
(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 "Project Next 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 (subproject))
(not (goal))
(not (area))
;; (subtask)
(not (ancestors (todo "TODO")))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled t)
(org-agenda-todo-ignore-deadlines t)
(org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Extra Next 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 t)
(org-agenda-todo-ignore-deadlines t)
(org-agenda-todo-ignore-with-date t)
(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 t)
(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 "Tasks in progress")
(org-agenda-prefix-format "[%(yant/get-clocked-time-today-for-agenda)%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))))
(tags-todo "/"
((org-agenda-overriding-header (concat "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))
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(tags-local "HOLD")
(not (tags-inherited "HOLD" "WAITING"))
(not (tags "CANCELLED" "SOMEDAY"))
(task)))))
(org-tags-match-list-sublevels nil)
(org-agenda-sorting-strategy
'(todo-state-down))))
(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
'(and
(or (project) (area))
(not (goal))
(not (todo "SOMEDAY" "TODO"))
(not (done))
(or (todo "NEXT" "REVIEW" "DOING")
(not (subproject)))
(not (tags "CANCELLED" "WAITING" "HOLD" "SOMEDAY"))
(not (descendants
'(and (if (area)
(todo "NEXT" "REVIEW" "DOING" "TODO")
(todo "NEXT" "REVIEW" "DOING"))
(not (tags "WAITING" "CANCELLED" "HOLD" "SOMEDAY"))
(not (habit)))))
(if (area)
;; Areas can only be stuck only when there are actual tasks inside.
(descendants '(and (todo) (not (todo "TICKLER")) (not (habit))))
t))))
(org-agenda-todo-ignore-scheduled t)
(org-agenda-sorting-strategy
'(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 (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))
(not (org-agenda-skip-before-SHOWFROMDATE-property))
(or (tags-local "HOLD")
(and (tags-local "WAITING")
(not (tags-local "TRACK"))))
(not (tags-inherited "HOLD" "WAITING"))
(not (tags "CANCELLED" "SOMEDAY"))
(task)))))
(org-tags-match-list-sublevels nil)
(org-agenda-sorting-strategy
'(todo-state-down))))
(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
'(and
(or (project) (area))
(not (goal))
(not (todo "SOMEDAY" "TODO"))
(not (done))
(or (todo "NEXT" "REVIEW" "DOING")
(not (subproject)))
(not (tags "CANCELLED" "WAITING" "HOLD" "SOMEDAY"))
(not (descendants
'(and (if (area)
(todo "NEXT" "REVIEW" "DOING" "TODO")
(todo "NEXT" "REVIEW" "DOING"))
(not (tags "WAITING" "CANCELLED" "HOLD" "SOMEDAY"))
(not (habit)))))
(if (area)
;; Areas can only be stuck only when there are actual tasks inside.
(descendants '(and (todo) (not (todo "TICKLER")) (not (habit))))
t))))
(org-agenda-todo-ignore-scheduled t)
(org-agenda-sorting-strategy
'(category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Project Next Tasks")
(org-agenda-prefix-format "[%(yant/get-clocked-time-today-for-agenda)%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 (subproject))
(not (goal))
(not (area))
;; (subtask)
(not (ancestors (todo "TODO")))))))
(org-tags-match-list-sublevels t)
(org-agenda-todo-ignore-scheduled t)
(org-agenda-todo-ignore-deadlines t)
(org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy
'(priority-down todo-state-down effort-up category-keep))))
(tags-todo "/"
((org-agenda-overriding-header "Extra Next Tasks")
(org-agenda-prefix-format "[%(yant/get-clocked-time-today-for-agenda)%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 t)
(org-agenda-todo-ignore-deadlines t)
(org-agenda-todo-ignore-with-date t)
(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 t)
(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 t)
(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 t)
(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))))(use-package org
:defer t
:init
(setq org-agenda-text-search-extra-files
'("~/Org/nodeadline_archive_2019.org"
"~/Org/nodeadline_archive_2020.org"
"~/Org/nodeadline_archive_2021.org"
"~/Org/References_archive_2020.org"
"~/Org/References_archive_2021.org"
"~/Org/schedule-work.org"
"~/Org/schedule-work_archive_2017.org"
"~/Org/schedule-work_archive_2018.org")))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
(condition-case _
(let ((completion-extra-properties '(:category org-tag)))
(completing-read "Location context: " location-tags nil 'must-match))
(quit nil))))
(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))))))))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)))- 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.
Similar idea with must-do -> want to do if have time is described in [[id:Youtube-grey2011-time-management-teachers-01b][CGP Grey [Youtube] (2011) Time Management for Teachers]]
(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))
(or
;; always show active timestamps (events)
(ts-active :on today :with-time t)
;; Show all the deadline except scheduled in future
(and (deadline)
(not (scheduled :from +1)))
(and
(not (tags "CANCELLED"))
(or (not (tags "WAITING" "HOLD"))
(not (todo "TICKLER")))
(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")))))
(not (org-agenda-skip-before-SHOWFROMTIME-property))
(not (org-agenda-skip-before-SHOWFROMDATE-property)))))
(setq org-agenda-skip-scheduled-if-done t)
(setq org-agenda-skip-deadline-if-done t)
(setq org-agenda-include-inactive-timestamps nil)[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)))))- 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.
: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)))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))<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)))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).
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)))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))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 #'replace-regexp-in-string "\n" "\n\n")
(apply-partially #'s-word-wrap 80)
#'s-trim
(apply-partially #'replace-regexp-in-string "\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))))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 (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)
(setq org-ql-defpred-defer t)
(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= "c")) (tags-local "contact"))
((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= "a")) "contact")
((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]
(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 &optional with-title)
"Insert URL from link at point.
When optional argument WITH-TITLE is non-nil, insert link title as
description as well."
(let ((link (or (org-entry-get marker "Source")
(org-entry-get marker "URL")))
(title (and with-title (org-element-property :title (org-element-at-point marker)))))
(cond
(link
(save-match-data
(string-match "^\\(?:\\[\\[\\)?\\([^]]+\\)" link)
(org-insert-link nil (match-string 1 link) title)
;; (insert (match-string 1 link))
))
((and (org-entry-get marker "LINK")
(or (string= "ML:Org mode" (org-entry-get marker "HOWPUBLISHED"))
(string= "ML:Emacs devel" (org-entry-get marker "HOWPUBLISHED"))))
(setq link (org-entry-get marker "LINK"))
(let ((list-url
(pcase (org-entry-get marker "HOWPUBLISHED")
("ML:Org mode" "https://orgmode.org/list/")
("ML:Emacs devel" "https://yhetil.org/emacs-devel/")))
full-url)
(save-match-data
(setq
full-url
(cond
((string-match "^notmuch:id:\\(.+\\)" link)
(format "%s%s" list-url (match-string 1 link)))
((string-match "^notmuch:thread:\\(.+\\)" link)
(let ((msgid (symbol-name (notmuch-call-notmuch-sexp "search" "--output=messages" (match-string 1 link)))))
(string-match "^id:\\(.+\\)" msgid)
(format "%s%s" list-url (match-string 1 msgid))))))
(org-insert-link nil full-url title)))))))
(defun yant/helm-org-ql-insert-url-w-title (marker)
"Insert URL link with title from link at point."
(yant/helm-org-ql-insert-url marker t))
(defun yant/helm-org-ql-open-url (marker)
"Open URL from link"
;; Indicate that we do not need to stay in current frame.
;; (setq helm-exit-status 1)
(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-reveal)
;; (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)
("Insert URL link w title of heading" . yant/helm-org-ql-insert-url-w-title)
("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))))This was first inspired by [[id:Github-org-roam-org-roam-org-3b7][org-roam [Github] org-roam/org-roam: Rudimentary Roam replica with Org-mode]] and then extended using ideas from [[id:Writings.Stephenwolfram-seeking-productive-life-a14][[Writings.Stephenwolfram] Seeking the Productive Life: Some Details of My Personal Infrastructure—Stephen Wolfram Writings]].
With helm, helm-org-ql, and notmuch, I can search pretty much through everything I got digitally. Be it bookmarks, personal notes, emails, files, buffers, etc.
(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
:after helm-notmuch
:custom
(helm-org-ql-reverse-paths t)
(helm-org-ql-show-paths nil)
(helm-org-ql-input-idle-delay 0.1)
(helm-candidate-number-limit 300)
:config
(require 'helm-org-ql)
(require 'helm-notmuch)
(use-package boon
:config
(cl-defun yant/helm-git-list-candidates (repo &key (branch "main") grep (limit 100))
"Return commits from REPO on BRANCH matching GREP up to LIMIT."
(let ((default-directory repo))
(with-temp-buffer
;; Reverse-engineering magit API
(cl-letf (((symbol-function 'magit-log-format-margin)
(lambda (hash author date)
(cl-letf (((symbol-function 'magit-make-margin-overlay)
(lambda (text _)
(insert " ("
(replace-regexp-in-string " +" " " text)
")")))
(magit-buffer-margin '(t age 18 t 18)))
(magit-log-format-author-margin author date)))))
(magit-git-wash (apply-partially #'magit-log-wash-log 'log)
"log"
"--format=%h%x0c%x0c%G?%x0c%aN%x0c%at%x0c%s"
"--regexp-ignore-case"
(when grep
(cl-typecase grep
(string (list "--grep" grep))
(list
(nconc (list "--all-match")
(flatten-list
(mapcar
(lambda (s) (list "--grep" s))
grep))))))
"--max-count" (number-to-string limit)
"--use-mailmap"
"--no-prefix"
branch "--"))
(let ((candidates))
(goto-char (point-min))
(while (not (eobp))
(when (looking-at "^\\S-+")
(push
;; CANDIDATE
(cons
;; DISPLAY
(buffer-substring (line-beginning-position) (line-end-position))
;; REAL: (repo branch hash)
(list repo branch (match-string 0)))
candidates))
;; Next line
(beginning-of-line 2))
(nreverse candidates)))))
(defun yant/helm-git-show-candidate (candidate)
"Show Magit commit CANDIDATE."
(pcase-let ((`(,repo _ ,hash) candidate))
(let ((default-directory repo))
(magit-show-commit hash))))
(defun yant/helm-git-insert-link (candidate)
"Insert link to commit CANDIDATE."
(pcase-let ((`(,repo ,branch ,hash) candidate))
(let* ((default-directory repo)
(origin (string-trim (shell-command-to-string "git remote get-url origin"))
;; FIXME: This is not reliable - multiple remotes may mean anything.
;; (string-trim (shell-command-to-string "git remote get-url $(git remote show | tail -n1)"))
))
(cond
((string-match "git\\.savannah\\.gnu\\.org:/srv/git/\\(.+\\)" origin)
(insert
(format "https://git.savannah.gnu.org/cgit/%s/commit/?id=%s"
(match-string 1 origin)
hash)))
((string-match "github.com:\\(.+\\)\\.git" origin)
(insert
(format "https://github.com/%s/commit/%s"
(match-string 1 origin)
hash)))
((string-match "sr\\.ht:\\(.+\\)" origin)
(insert
(format "https://git.sr.ht/%s/commit/%s"
(match-string 1 origin)
hash)))
(t nil)))))
(defvar yant/helm-git-actions
'(("Show in Magit" . yant/helm-git-show-candidate)
("Show in Magit" . yant/helm-git-show-candidate)
("Insert link" . yant/helm-git-insert-link)
("Insert URL" . yant/helm-git-insert-link)))
(cl-defun yant/helm-git-make-source (repo &key (branch "main"))
"Build Helm source for Git REPO."
(helm-build-sync-source (format "Git: %s" repo)
:candidates
`(lambda ()
(yant/helm-git-list-candidates
,repo
:branch ,branch
:grep (split-string (string-clean-whitespace helm-pattern))
:limit (min 50 helm-candidate-number-limit)))
:action yant/helm-git-actions
:match #'identity
:fuzzy-match nil
:multimatch nil
:nohighlight t
:match-dynamic t))
(defvar yant/helm-git-sources (list (yant/helm-git-make-source "~/Git/org-mode")
(yant/helm-git-make-source "~/Git/worg" :branch "master")
(yant/helm-git-make-source "~/Git/org-mode-tests" :branch "master"))
"Sources for Git repositories")
(require 'helm-for-files)
(defvar yant/helm-org-ql-agenda-files-history nil
"`yant/helm-org-ql-agenda-files' query history.")
(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-buffer-max-length 80))
(helm :prompt (format "Query (boolean and): ")
:truncate-lines t
:history 'yant/helm-org-ql-agenda-files-history
:sources `(,(helm-make-source "Buffers" 'helm-source-buffers)
,(helm-make-source "Recentf" 'helm-recentf-source
:fuzzy-match helm-recentf-fuzzy-match)
,(helm-org-ql-source files
:name "Org Agenda Files"
:filter (unless search-archives-p
'(not (and (not (tags-local "ARCHIVE"))
(tags "ARCHIVE"))))
:limit-count helm-candidate-number-limit)
,helm-source-notmuch
,(helm-make-source "External Commands" 'helm-external-commands
:data (helm-external-commands-list-1 'sort)
:candidate-number-limit 15
:action
;; Modify default action to set
;; `helm-exit-status' to 1, making
;; system runner exit immediately.
(helm-make-actions
"Run program"
(lambda (candidate)
(helm-run-external-command-action candidate)
(setq helm-exit-status 1))
(lambda ()
(unless (memq system-type '(windows-nt ms-dos))
"Run program detached"))
(lambda (candidate)
(helm-run-external-command-action candidate 'detached)
(setq helm-exit-status 1))))
,(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"))))))
,@yant/helm-git-sources))
;; Remove from history no more valid executables.
(setq helm-external-command-history
(cl-loop for i in helm-external-command-history
when (executable-find i) collect i)))))
(bind-key "h" #'yant/helm-org-ql-agenda-files boon-forward-search-map))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)))(setq org-agenda-fontify-priorities nil)(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-regexp-in-string "\n.+" "" 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))))Custom sorting of entries in subtrees using per-subtree/global ordering.
(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 '("REVIEW" "DOING" "NEXT" "HOLD" "WAITING" "TODO" "SOMEDAY" "TICKLER" "FROZEN" "MERGED" "FAILED" "DONE" "CANCELLED"))
(setq org-autosort-global-sorting-strategy
'(todo-up
priority-down
(:key (lambda () (if (member "FLAGGED" (org-get-tags nil 'local)) "1" "2")))
( :key (lambda () (if-let ((year (org-entry-get nil "YEAR"))) (string-to-number year) 0))
:cmp >)))
(bind-key "C-c C-S-s" 'org-autosort-sort-entries-at-point org-mode-map)
(add-to-list 'org-default-properties "SORT"))(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 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-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 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)
(= 0 (org-emacs-idle-seconds)))
(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.
(setq org-log-into-drawer t
org-log-state-notes-insert-after-drawers t
org-log-done 'time
org-log-refile 'time)- 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
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))I do not show current task in Emacs, instead I use awesome 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\n\n%s" org-time-balance org-time-balance-lossage)))))
(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\n%s" str time-balance org-time-multiplier org-time-balance-lossage))))))
(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)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.
[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))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)(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)
))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 (* 10 60)) ; 10 minutes
:config
(org-clock-auto-clockout-insinuate))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))#org_time_balance
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.
(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
(org-with-point-at-org-buffer
(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
(org-with-point-at-org-buffer
(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")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))(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.
(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")))
(define-advice org-capture-place-template (:after (&rest _) delete-windows) (delete-other-windows))
(define-advice org-capture-select-template (:around (fun &rest args) delete-capture-frame)
"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"
(let ((return (or
(ignore-errors (apply fun args))
"q")))
(when (and (equal "q" return)
(equal "org-capture-pop-frame" (frame-parameter nil 'name)))
(delete-frame))
return)))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)))))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:
# -*- mode: snippet -*-
# name: todo_capture
# key: todo_capture_
# --
TODO ${1:Title} ${2:`(string-trim-right (org-capture-fill-template "%a"))`}
:PROPERTIES:
:CREATED: `(string-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
(setf
(alist-get "n" org-capture-templates nil nil #'equal)
(cdar (doct
'("NEXT item"
:keys "n"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"todo_capture_\")"))))))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} `(string-trim-right (org-capture-fill-template "%a"))`
:PROPERTIES:
:CREATED: `(string-trim-right (org-capture-fill-template "%U"))`
:ORG-TIME-BONUS-ON-DONE: 20
:END:
$0
(setf (alist-get "t" org-capture-templates nil nil #'equal)
(cdar (doct '("Singular TODO item"
:keys "t"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"todo_singular_capture_\")")))))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 " (string-trim-right (org-capture-fill-template "%u"))))`} :note:
:PROPERTIES:
:CREATED: `(string-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: `(string-trim-right (org-capture-fill-template "%a"))`}
$0
(setf (alist-get "N" org-capture-templates nil nil #'equal)
(cdar (doct
'("Note"
:keys "N"
:type entry
:file "~/Org/inbox.org"
:template
("* %(ya-org-capture/make-snippet \"note_capture_\")")))))(setf (alist-get "c" org-capture-templates nil nil #'equal)
(cdar (doct
'("Quick note to current task"
:keys "n"
:type item
:clock t
:template
("- %u %?")))))I default it to no logging.
(setf (alist-get "h" org-capture-templates nil nil #'equal)
(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")))))Scheduled event. It is saved to org-gcal org file.
(setf (alist-get "M" org-capture-templates nil nil #'equal)
(cdar (doct '("Scheduled event/meeting"
:keys "M"
:type entry
:file "~/Org/schedule.org"
:template
("* %? :%^G:"
"%^T"
"\n")))))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.
(setf (alist-get "R" org-capture-templates nil nil #'equal)
(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}"
)))))A large task that needs to be studied systematically. It has to have a concrete outcome
(setf (alist-get "P" org-capture-templates nil nil #'equal)
(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."
"** Raw data :REFILE:NOARCHIVE:"
"# The raw 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:")))))
(setf (alist-get "G" org-capture-templates nil nil #'equal)
(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:")))))(setf (alist-get "p" org-capture-templates nil nil #'equal)
(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:"
"** Bookmarks \ References :REFILE:"
"** 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")))))(setf (alist-get "J" org-capture-templates nil nil #'equal)
(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"
"*** TODO Graphical abstract"
"*** NEXT Introduction"
"*** TODO Methods"
"*** TODO Results"
"*** TODO Discussion"
"*** TODO Conclusions"
"** TODO Email manuscript to co-authors"
"** TODO Revise"
":PROPERTIES:"
":REPEAT_TO_STATE: NEXT"
":LOGGING: nil"
":END:"
"** TODO Cover letter to coordinating editor"
"# Why should this manuscript be published in *the* journal."
"** TODO Upload data to zenodo"
"** TODO Suggest reviewers"
"** 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]]")))))(setf (alist-get "A" org-capture-templates nil nil #'equal)
(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:article:"
":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]]")))))(setf (alist-get "F" org-capture-templates nil nil #'equal)
(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")))))(setf (alist-get "f" org-capture-templates nil nil #'equal)
(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")))))(setf (alist-get "C" org-capture-templates nil nil #'equal)
(cdar (doct '("Contact"
:keys "C"
:type entry
:file "~/Org/contacts.org"
:template
("* %^{Name} %? :contact:"
":PROPERTIES:"
":CREATED: %U"
":EMAIL: %^{Email}"
":END:")))))(setf (alist-get "E" org-capture-templates nil nil #'equal)
(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"
"%?")))))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))(setf (alist-get "T" org-capture-templates nil nil #'equal)
(cdar (doct '("Travel"
:keys "T"
:type entry
:file "~/Org/inbox.org"
:template
("* TODO Travel to %^{Destination}"
":PROPERTIES:"
":CREATED: %U"
":ATTACH_DIR_INHERIT: t"
":END:"
"# A short note about destination and why I want to go."
"%?"
"** TODO Check visa and other legal requirements"
"** TODO Mark interesting places to visit on the map"
"** Notes and photos"
"** TODO Check people I want to visit"
"** TODO Check hotels near interesting places"
"** TODO Estimate transportation routes"
"** TODO Estimate rough itenerary to get time frames"
"** TODO Allocate vacation"
"** TODO Get visa / plan how to get it"
"** TODO Get tickets"
"** TODO Pack"
"- [ ] shoe brush and cloth brush (small)"
"- [ ] toothbrush (but no liquid)"
"- [ ] nailcut"
"- [ ] chargers: mobile, watches"
"- [ ] power bank"
"- [ ] power adaptor"
"- [ ] deodorant, shampoo"
"- [ ] tissue (not all plces are that good)"
"- [ ] dental floss"
"- [ ] headache pills"
"- [ ] clothes according to the plan and timing")))))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
: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)
(mapconcat
#'identity
'("- [ ] [[elisp:(browse-url (url-encode-url (format \"https://sci-hub.se/%s\" (org-entry-get nil \"DOI\"))))][downlaod 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")
"\n")
""))
: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)
(setf (alist-get (car template) org-capture-templates nil nil #'equal)
(cdr template)))))- 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)
(setf (alist-get (car template) org-capture-templates nil nil #'equal)
(cdr template))))))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
Storing captured references in local archive with https://github.com/Y2Z/monolith
(when init-flag
(defvar yant/org-capture-archive-process nil)
(defvar yant/org-capture-archive-markers nil)
(when (fboundp 'org-track-markers-register)
(org-track-markers-register 'yant/org-capture-archive-markers))
(defun yant/org-capture-archive-resource (&optional url attach-dir marker)
"Archive resource for capture at point/MARKER or for URL."
(org-with-point-at marker
(when-let ((url (or url (org-entry-get (point) "URL")))
(url-archivable? (not (seq-find
(lambda (host) (string-match-p (regexp-quote host) url))
(append (when (boundp 'yant/mastodon-hosts)
yant/mastodon-hosts)
'("author.today")))))
(attach-dir (or attach-dir (org-attach-dir-get-create))))
(if (and yant/org-capture-archive-process
(process-live-p yant/org-capture-archive-process))
(run-with-timer
30 nil #'yant/org-capture-archive-resource
url attach-dir
(or marker
(let ((mk (point-marker)))
;; We may be inside temporary indirect capture
;; buffer - set marker inside the parent buffer.
(when (buffer-base-buffer)
(move-marker mk (point) (buffer-base-buffer)))
(cl-pushnew mk yant/org-capture-archive-markers)
mk)))
(org-toggle-tag org-attach-auto-tag 'on)
(setq yant/org-capture-archive-markers
(delete marker yant/org-capture-archive-markers))
(setq yant/org-capture-archive-process
(if (string-match-p "youtube" url)
(start-process
"yt-dlp" " *yt-dlp*"
"yt-dlp"
"--quiet" "--no-progress" "--no-colors"
"-S" "height:1080"
"--write-description"
"-o" (file-name-concat attach-dir "%(title)s [%(id)s].%(ext)s")
url)
(start-process
"Monolith" " *Monolith*"
"monolith"
url
"--output" (file-name-concat attach-dir "singlepage.html"))))))))
(add-hook 'org-capture-before-finalize-hook #'yant/org-capture-archive-resource))(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."
(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)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)
)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)
)- 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-allow-bind-keywords t)
(setq org-export-use-babel t) (use-package ob-core :config (setf (alist-get :eval org-babel-default-header-args) "never-export"))
(use-package orgdiff
:if init-flag
:after org
:requires (ox-latex)
:straight (orgdiff :host github :repo "tecosaur/orgdiff" :local-repo "~/Git/orgdiff"
:fork (:host github :repo "yantar92/orgdiff"))):ignore: tag.
The subheadings below such a headlines are promoted up 1 level.
(use-package ox-extra
:config
(ox-extras-activate '(ignore-headlines)))(setq org-export-exclude-tags '("NOEXPORT"))
(setq org-latex-pdf-process
'("latexmk -pdf -%latex -shell-escape -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)(use-package ox-latex
:config
(setq org-latex-image-default-width "\\linewidth"))(add-to-list 'org-latex-classes
'("Cover letter"
"\\documentclass\[%
DIV=14,
fontsize=12pt,
parskip=half,
subject=titled,
backaddress=false,
fromalign=left,
fromemail=false,
fromname=false,
fromphone=true\]\{scrlttr2\}
\[DEFAULT-PACKAGES]
\[PACKAGES]
\[EXTRA]"))
(add-to-list 'org-latex-classes
'("Acta paper"
"\\documentclass[5p]{elsarticle}
%% Include references from supplementary into file.
\\journal{Acta Materiallia}
\\bibliographystyle{model1-num-names}
\\biboptions{sort&compress,numbers}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(add-to-list 'org-latex-classes
'("Acta paper preprint"
"\\documentclass[preprint]{elsarticle}
%% Include references from supplementary into file.
\\journal{Acta Materiallia}
\\bibliographystyle{model1-num-names}
\\biboptions{sort&compress,numbers}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(add-to-list 'org-latex-classes
'("Acta paper review"
"\\documentclass[review]{elsarticle}
%% Include references from supplementary into file.
\\journal{Acta Materiallia}
\\bibliographystyle{model1-num-names}
\\biboptions{sort&compress,numbers}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(add-to-list 'org-latex-classes
'("Acta supplementary"
"\\documentclass[1p]{elsarticle}
%% Include references from supplementary into file.
\\journal{Acta Materiallia}
\\bibliographystyle{model1-num-names}
\\biboptions{sort&compress,numbers}"
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}")))
(use-package ox-latex
:config
(add-to-list 'org-latex-packages-alist '("" "listings"))
(add-to-list 'org-latex-packages-alist '("" "color"))
(setq org-latex-listings-options '(("basicstyle" "\\small")
("numbers" "left")
("breaklines" "true")
("frame" "tl")))
)
;; (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"
;; )))
(use-package org
:config
(use-package engrave-faces
:straight (engrave-faces :host github :repo "tecosaur/engrave-faces"))
(add-to-list 'org-latex-engraved-options '("breakanywhere" . "true"))
(setq org-latex-listings 'engraved))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)))(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\\)\\'")))(use-package ox-md)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)
(use-package org-ql
:demand t
:config
(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."
(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"))
(not (tags-inherited "ARCHIVEALL"))
(or (not (tags "NOARCHIVE"))
(and (not (tags-local "NOARCHIVE"))
(org-inlinetask-at-task-p))))))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 (directory-files "~/Org" nil ".*\\.org"))
: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)))))
)
)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:.
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.
(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 (and (< (point) limit) (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))
(source (org-entry-get (point) "URL")))
(when (and
(org-attach-dir)
(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-excursion
(save-window-excursion
(pop-to-buffer dired-buf)
(revert-buffer)
(select-window (old-selected-window))
(prog1
(or
(member (directory-files (buffer-local-value 'default-directory dired-buf)) '(nil ("." ".." "singlepage.html") ("." "..")))
(yes-or-no-p (format "%s: Delete all attachments? "
heading)))
(kill-buffer dired-buf)))))
org-attach-archive-delete))
(org-attach-delete-all t)))))))))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) (org-attach-dir) (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
(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)
(if (file-directory-p file)
(copy-directory file (format "%s/%s" new-dir (file-name-nondirectory file)) t)
(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 (lambda (file) (if (file-directory-p file) (delete-directory file t) (delete-file 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))))(use-package org-archive
:if init-flag
:after org
:demand org-ql
:config
(define-advice org-archive-subtree (:around (oldfun &optional find-done) query-project)
"Ask about archiving projects."
(interactive "P")
(let* ((projects (and (org-at-heading-p)
(save-restriction
(org-narrow-to-subtree)
(org-ql-query :select #'point :from (current-buffer) :where '(project) :narrow t))))
(headlines (mapconcat (lambda (p) (org-with-point-at p (org-get-heading))) projects "\n")))
(when (or (not projects)
(yes-or-no-p
(format "Trying to archive projects:\n%s\nReally archive?" headlines)))
(funcall-interactively oldfun find-done)))))(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))
(children (when (org-element-property :contents-begin (org-element-at-point))
(org-buffer-substring-fontified
(org-element-property :contents-begin (org-element-at-point))
(org-element-property :contents-end (org-element-at-point))))))
(when (or (not has-children)
(yes-or-no-p (format "%s\n%s: There are child headings. Really archive?" children headline)))
(funcall-interactively oldfun find-done)))))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))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)
(push (cons "p" "src python :results output") org-structure-template-alist)
(push (cons "jp" "src jupyter-python") org-structure-template-alist))(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)
(plantuml . t)))Noweb is useful, I’d rather enable it everywhere than set it every
time to run the code.
(use-package ob-core
:config
(setf (alist-get :noweb org-babel-default-header-args) "yes"))(use-package ob-core
:config
(setf (alist-get :comments org-babel-default-header-args) "link"))Put shell output into results by default
(use-package ob-shell
:config
(setf (alist-get :results org-babel-default-header-args:shell) "output"))Show stderr in the shell output (Source)
(use-package ob-shell
:config
(setf (alist-get :prologue org-babel-default-header-args:sh) "exec 2>&1")
(setf (alist-get :epilogue org-babel-default-header-args:sh) ":"))- State “TODO” from [2018-07-11 Wed 09:19]
(setq org-confirm-babel-evaluate nil)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 (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
(lambda ()
(unless (eq this-command 'org-babel-tangle)
(org-display-inline-images
nil nil
(save-excursion (org-back-to-heading-or-point-min t) (point))
(save-excursion (or (outline-next-heading) (point-max)))))))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.
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 quote(use-package ob-plantuml
:defer t
:custom
(org-plantuml-exec-mode 'plantuml))(when init-flagPreview images and latex formulas.
(setq org-image-actual-width nil)
(setq org-latex-create-formula-image-program 'imagemagick)
(setq org-preview-latex-default-process 'dvisvgm)
(setq org-format-latex-options
(quote
(:foreground default :background "Transparent" :scale 1.5 :justify center :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 :matchers
("begin" "$1" "$" "$$" "\\(" "\\["))));; 1.5x 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= "" (string-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 )
))(use-package org-entities
:config
(add-to-list 'org-entities-user '("angstrom" "\\AA" nil "&Å;" "A" "A" "Å")))(use-package org-faces
:config
(set-face-attribute
'org-checkbox nil
:box nil
:background (face-background 'default)))(use-package org-faces
:if init-flag
:custom-face
(org-verbatim ((t (:height 0.95 :weight semi-light)))))(use-package ol
:config
(org-link-set-parameters
"file"
:face
(lambda (path)
(let ((file (org-link-unescape path)))
(if (or (file-remote-p file) (file-exists-p file))
'org-link
'org-warning)))))I do not want bigger items font because I tend to use items a lot.
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)
(?📎 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 ":\\(book\\):" (org-mode) 1)
(?🎬 org-specific ":\\(video\\):" (org-mode) 1)
(? org-specific ":\\(TRACK\\):" (org-mode) 1)
(?🖇 org-specific ":\\(misc\\):" (org-mode) 1)
(?🖂 org-specific ":\\(email\\):" (org-mode) 1)
(?📥 org-specific ":\\(INBOX\\):" (org-mode) 1)
(?📦 org-specific ":\\(ARCHIVE\\):" (org-mode) 1)
('(?📦 (cc . cc) ?🚫) org-specific ":\\(NOARCHIVE\\):" (org-mode) 1)
(?🔐 org-specific ":\\(CRYPT\\):" (org-mode) 1)
(?📜 org-specific ":\\(article\\):" (org-mode) 1)
(?⤋ org-specific ":\\(REFILE\\):" (org-mode) 1)
('(?⤋ (cc . cc) ?🚫) org-specific ":\\(NOREFILE\\):" (org-mode) 1)
(?✎ org-specific ":\\(note\\):" (org-mode) 1)
(?🏁 org-specific ":\\(GOAL\\|goal\\):" (org-mode) 1)
(?📚 org-specific ":\\(area\\|AREA\\):" (org-mode) 1)
(?🔔 org-specific ":\\(FLAGGED\\|flagged\\):" (org-mode) 1)
(?☐ org-specific "\\(?:^*+ +\\)\\(\\<TODO\\>\\)" (org-mode) 1)
(?⯑ org-specific "\\(?:^*+ +\\)\\(\\<SOMEDAY\\>\\)" (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 ":\\(TICKLER\\):" (org-mode) 1)
(?🔁 org-specific "\\(?:^*+ +\\)\\(\\<MERGED\\>\\)" (org-mode) 1)
(?⌛ org-specific "\\(?:^*+ +\\)\\(\\<WAITING\\>\\)" (org-mode) 1)
(?⌛ org-specific ":\\(WAITING\\):" (org-mode) 1)
(?⏩ org-specific "\\(?:^*+ +\\)\\(\\<DOING\\>\\)" (org-mode) 1)
(?⏸ org-specific "\\(?:^*+ +\\)\\(\\<HOLD\\>\\)" (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)No blanks in items and between headings
Todo 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))))Do not adjust tags. It does not work well in resized windows without line truncation.
(setq org-tags-column 0)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)))))))(use-package org
:custom
(org-fontify-done-headline nil))(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) (match-end 1) `(face yant/org-agenda-highlight-face font-lock-fontified t))))))(use-package org
:custom (org-hide-leading-stars t))Do not dim blocked taks, like tasks with checkboxes.
(use-package org-agenda
:custom (org-agenda-dim-blocked-tasks nil))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)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-with-point-at-org-buffer (org-entry-get (point) "SUMMARY"))))
(if (not (seq-empty-p summary))
(format "[%s] " summary)
"")))
(defun yant/get-clocked-time-today-for-agenda ()
"Get total clocked-in time for an entry in agenda."
(let ((minutes (org-with-point-at-org-buffer
(org-narrow-to-subtree)
(org-clock-sum-today))))
(if (= minutes 0) "" (concat (org-duration-from-minutes minutes 'h:mm) "/"))))
(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
(let (hashtags (pos 0))
(while (string-match " #[^+ ][^# ]+" entry-text pos)
(push (match-string 0 entry-text) hashtags)
(setq pos (match-end 0)))
(nreverse hashtags)))))
(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 [%(yant/get-clocked-time-today-for-agenda)%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(search . "%s %-14.14:c [%(yant/get-clocked-time-today-for-agenda)%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(todo . "%-14.14:c [%(yant/get-clocked-time-today-for-agenda)%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")
(tags . "%-14.14:c [%(yant/get-clocked-time-today-for-agenda)%-4e] %?-12t%(yant/format-time-balance-multiplier) %(yant/format-summary-for-agenda)")))Hide some uninteresting tags
(setq org-agenda-hide-tags-regexp
(rx (or "DEFAULT" "flagged" "NOFOLLOW" "TICKLER" "SKIP"
"NOARCHIVE" "INBOX" "HOLD" "WAITING" "NODEADLINE"
"CANCELLED" "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.
#align #agenda
(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
(erase-buffer)
(insert 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
(erase-buffer)
(insert 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
(erase-buffer)
(insert 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))
(delete-region pos next)))
(goto-char (point-min))
(let ((window-width (window-width))
(ellipsis "…")
(gap " "))
(while (and (goto-char (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))))
(when tag-width
(save-excursion
(let ((truncated (string-display-truncate
(buffer-substring beg end)
(- window-width
tag-width
(string-display-width (concat ellipsis gap)))
nil 'hide ellipsis)))
(delete-region beg end)
(goto-char beg)
(insert truncated)))
(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 'org-agenda-finalize-hook #'org-agenda-truncate-headings 90)
;; (add-hook 'org-agenda-finalize-hook (lambda () (add-hook 'window-configuration-change-hook #'org-agenda-truncate-headings nil 'local)))(use-package org-agenda
:if init-flag
:custom-face
(org-scheduled-today ((t (:foreground "DarkSlateGray"))))
(org-agenda-done ((t . (:foreground "Springgreen4" :slant normal)))))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))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))))))(use-package org
:requires macrostep
:config
(defface yant/org-agenda-highlight-face `((t :inherit modus-themes-nuanced-yellow :extend t))
"Face used to highlight flagged entries in agenda view.")
(set-face-background 'org-agenda-clocking (face-background 'diff-added nil t))
(set-face-attribute 'org-agenda-clocking nil :extend t)
(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))
(use-package org
:custom-face
(org-drawer ((t (:foreground "Blue1" :height 0.8)))))(use-package org
:init
(add-hook 'org-cycle-hook #'org-cycle-hide-drawers))Dim keywords and use smaller font size as in Smaller font for property drawers.
(use-package org-faces
:defer t
:config
(set-face-attribute 'org-special-keyword nil :inherit '(shadow org-drawer)))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 '{})(use-package org-eldoc
:after org
:demand t)- 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)))(use-package org
:if init-flag
:after boon
:config
(meta-defun meta-split :mode org-mode (org-babel-demarcate-block))
(bind-key "S" #'meta-split boon-command-map))(use-package org
:config
(setf (alist-get 'plain-list-item org-blank-before-new-entry) nil))(use-package org
:if init-flag
:config
(remove-hook 'org-cycle-hook #'org-cycle-optimize-window-after-visibility-change))(use-package ol-notmuch
:after org
:straight t
:init (require 'notmuch)
:custom
(org-notmuch-open-function #'org-notmuch-follow-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/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)(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)))Some 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]*:RSS: .+\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]*- Following up ::.+\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))
(member (magit-jump-to-staged)
'(nil "Section \"Staged changes\" wasn’t found")))
(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)
;; (yant/magit--autocommit)
(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))
(previous-pos (point))
(progress (make-progress-reporter "Autocommiting hunks..." 1 (point-max))))
(catch :last-section
(let (
;; Make magit refresh faster.
(magit-section-cache-visibility nil)
;; Simplify magit-status-sections-hook.
(magit-status-sections-hook '(magit-insert-unstaged-changes))
;; disable some hooks
(magit-section-set-visibility-hook nil))
(magit-refresh)
(while (with-current-buffer magit-buffer
(< pos (point-max)))
(with-current-buffer magit-buffer
(save-excursion
(goto-char pos)
(progress-reporter-update progress pos)
(when (and (re-search-forward (rx-to-string `(or ,@(mapcar (lambda (re) `(regex ,re)) yant/magit-show-autocommit-regexps))) nil 'move)
(< (point) (point-max)))
(let ((section (magit-current-section)))
(if (not (eq 'hunk (oref section type)))
(condition-case err
(magit-section-forward)
(user-error
(setq pos (point))
(throw :last-section t)))
(let ((hunk-text (buffer-substring-no-properties (oref section start) (oref section end))))
(when (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
;; Do not refresh buffer.
(let ((magit-inhibit-refresh t))
(magit-stage))))
(setq previous-pos pos)
(condition-case err
(magit-section-forward)
(user-error
(setq pos (point))
(throw :last-section t)))))))
(setq pos (point)))))))
(magit-refresh)
(progress-reporter-done progress)
(with-current-buffer magit-buffer
(unless (magit-jump-to-staged) ;; returns nil on success.
(funcall-interactively
#'magit-commit-create
`("-m"
,(format-time-string "Autoupdate %Y-%m-%d" (current-time))))))))))(use-package org-crypt
:after org
:custom
(org-crypt-key "Ihor Radchenko")
:config
(if (boundp 'org-crypt-encrypt-on-save)
(setq org-crypt-disable-auto-save 'encrypt)
(org-crypt-use-before-save-magic)))- 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)))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
(unless (boundp 'org-crypt-encrypt-on-save)
(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)))))))Using because the package is abandoned and I am helping to maintain it.
(use-package org-page
:straight (org-page
:host github :repo "emacsorphanage/org-page"
:local-repo "~/Git/org-page")
:custom
(op/repository-directory "~/Git/Blog/")
(op/hashover-comments t)
(op/site-domain "localhost:8080/"))(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-n" . notes-open))
(bind-keys :map org-mode-map
("C-c C-l" . org-insert-link)
("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 (>= pos (point-max))
until (org-invisible-p pos)
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))))))))(add-hook 'org-capture-mode-hook 'boon-insert 'append)I have some really large Org files (20+Mb) and Emacs has a hard time rendering them, especially when huge chunks of text needs to be hidden within the window span inside folds.
This redisplay is especially annoying when I am not actually looking at that file, but Emacs still tries to render it briefly while displaying a message after refiling is done.
Work around this issue by suppressing messages coming from
org-store-log-note and org-archive-subtree.
(use-package org
:config
(define-advice org-store-log-note (:around (fun) silence)
"Run `org-store-log-note', but do not produce any message."
(let ((inhibit-message t)) (funcall fun)))
(define-advice org-archive-subtree (:around (fun &rest args) silence)
"Run `org-store-log-note', but do not produce any message."
(let ((inhibit-message t)) (funcall fun args))))Inspired by https://github.com/NicolasPetton/noccur.el, but only opens the buffers with actual matches rather than opening all the files in project.
(use-package project
:if init-flag
:bind
( :map project-prefix-map
("g" . yant/occur-current-project))
:init
(defun yant/occur-current-project (regexp &optional nlines directory-to-search)
"Perform `multi-occur' with REGEXP in the current project files.
When called with a prefix argument NLINES, display NLINES lines before and after.
If DIRECTORY-TO-SEARCH is specified, this directory will be searched recursively;
otherwise, the user will be prompted to specify a directory to search.
For performance reasons, files are filtered using 'find' or 'git
ls-files' and 'grep'."
(interactive
(list
(project--read-regexp)
(and current-prefix-arg (prefix-numeric-value current-prefix-arg))))
(let* ((default-directory
(or directory-to-search
(when-let ((pr (project-current t)))
(project-root pr))
(read-directory-name "Search in directory: ")))
(files
(mapcar #'find-file-noselect
(delete-dups
(mapcar
#'xref-file-location-file
(mapcar
#'xref-item-location
(xref-matches-in-files regexp (project-files (project-current t)))))))))
(multi-occur files regexp nlines))))(use-package piem
:if init-flag
:straight (piem :host nil :repo "https://git.kyleam.com/piem"))(use-package piem
:if init-flag
:init
(defun yant/piem-name-branch-prefix-who-what-v (info)
"Return prefixed `piem-name-branch-who-what-v'."
(concat "piem/" (piem-name-branch-who-what-v info)))
:custom
(piem-default-branch-function #'yant/piem-name-branch-prefix-who-what-v))(use-package piem
:custom
(piem-inboxes
'(( "Org mode"
:coderepo ("~/Git/org-mode/" "~/Git/worg/" "~/Git/orgweb/" "~/Git/org-contrib/")
:address "emacs-orgmode@gnu.org"
:listid "emacs-orgmode.gnu.org"
:url "https://orgmode.org/list/"
:maildir "~/Mail/Orgmode-maillist/orgmode/"))))(use-package piem
:after notmuch
:config (piem-notmuch-mode +1)
(use-package meta-functions
:config
(meta-defun meta-magit-status :mode notmuch-show-mode piem-am)))(use-package git-email
:if init-flag
:straight
(git-email
:type git
:repo "https://git.sr.ht/~yoctocell/git-email/"
;; I do not have mu4e installed and compilation failed unless I
;; exclude this file.
:files (:defaults (:exclude "git-email-mu4e.el"))))(use-package git-email
:custom
(git-email-format-patch-default-args "--attach"))(use-package git-email
:config
(defun yant/git-email-get-project-current ()
"Get current activae peoject.el project, if any."
(and (bound-and-true-p project-list-file)
(nth 2 (project-current))))
(add-hook 'git-email-get-current-project-functions #'yant/git-email-get-project-current))(use-package git-email
:after piem
:config
(git-email-piem-mode +1))(use-package git-email
:after notmuch
:config
(git-email-notmuch-mode +1))(use-package git-email
:after magit
:config
(require 'git-email-magit))(load "~/PersonalDocuments/emacs-personal.el")