feat: use el-patch
for patching functions
This commit is contained in:
parent
1ea7d5e3fc
commit
e322c3df69
477
config.org
477
config.org
|
@ -104,9 +104,13 @@ My mail client currently requires GPG access to sync emails, which doesn't prope
|
|||
|
||||
**** TODO Configure Org popups
|
||||
|
||||
* Config Management with =confpkg=
|
||||
* Configuration Support
|
||||
|
||||
As part of their literate config, Tecosaur implemented =confpkg=, an embedded Emacs Lisp library that manages multiple aspects of config tangling:
|
||||
A proper Emacs configuration is often so complex that it requires its own support code to ease the process of writing and maintaining it. Before the configuration itself, here's all the support systems it uses (aside from Doom Emacs itself, which is also configuration support).
|
||||
|
||||
** =confpkg=
|
||||
|
||||
As part of their own literate config, Tecosaur implemented =confpkg=, an embedded Emacs Lisp library that manages multiple aspects of config tangling:
|
||||
|
||||
- Controlling what generated files each code block is tangled to
|
||||
- Creating package files from templates
|
||||
|
@ -125,9 +129,9 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
- Hook only into babel calls that contain =confpkg= as a substring
|
||||
- Allow package statements anywhere in subconfig files, rather than only at the beginning
|
||||
|
||||
** confpkg :noexport:
|
||||
*** Source :noexport:
|
||||
|
||||
*** Preparation
|
||||
**** Preparation
|
||||
|
||||
#+name: confpkg-prepare
|
||||
#+begin_src emacs-lisp
|
||||
|
@ -148,7 +152,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
<<confpkg-prepare()>>
|
||||
#+end_src
|
||||
|
||||
*** Setup
|
||||
**** Setup
|
||||
|
||||
#+name: confpkg-setup
|
||||
#+begin_src emacs-lisp :results silent :noweb no-export
|
||||
|
@ -328,7 +332,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
(fill-comment-paragraph)
|
||||
(forward-paragraph 1)
|
||||
(forward-line 1))
|
||||
(if (equal (plist-get confpkg :package) "config-confpkg-timings")
|
||||
(if (equal (plist-get confpkg :package) "config-support--timings")
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(insert "\n\n\
|
||||
|
@ -376,7 +380,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
(insert "\n"))
|
||||
(buffer-string)))))
|
||||
(let ((confpkg-timings ;; Ensure timings is put first.
|
||||
(cl-some (lambda (p) (and (equal (plist-get p :package) "config-confpkg-timings") p))
|
||||
(cl-some (lambda (p) (and (equal (plist-get p :package) "config-support--timings") p))
|
||||
confpkg--list)))
|
||||
(append (list confpkg-timings)
|
||||
(nreverse (remove confpkg-timings confpkg--list)))))
|
||||
|
@ -415,7 +419,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
|
||||
#+call: confpkg-setup[:results none]()
|
||||
|
||||
*** Confpkg Dispatch
|
||||
**** Confpkg Dispatch
|
||||
|
||||
#+name: confpkg
|
||||
#+begin_src elisp :var name="" needs="" after="" pre="" prefix="config-" via="copy" :results silent raw :noweb no-export
|
||||
|
@ -520,7 +524,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
;;; %p.el ends here
|
||||
#+end_src
|
||||
|
||||
*** Quieter Output
|
||||
**** Quieter Output
|
||||
|
||||
#+name: confpkg-quieter-output
|
||||
#+begin_src emacs-lisp
|
||||
|
@ -539,7 +543,7 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
|
||||
#+call: confpkg-quieter-output()
|
||||
|
||||
*** CLI
|
||||
**** CLI
|
||||
|
||||
#+begin_src emacs-lisp :tangle cli.el :noweb-ref none
|
||||
;;; cli.el -*- lexical-binding: t; -*-
|
||||
|
@ -551,9 +555,9 @@ If you're reading the raw org file instead of the published version, the code fo
|
|||
(advice-add 'org-babel-execute-src-block :around #'doom-shut-up-a)
|
||||
#+end_src
|
||||
|
||||
*** Timings
|
||||
**** Timings
|
||||
|
||||
#+call: confpkg("Confpkg timings")
|
||||
#+call: confpkg("Support: timings")
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defvar confpkg-load-time-tree (list (list 'root)))
|
||||
|
@ -757,6 +761,107 @@ NODE defaults to the root node."
|
|||
(pop-to-buffer buf)))))
|
||||
#+end_src
|
||||
|
||||
** Source Code Patching
|
||||
|
||||
#+call: confpkg("Support: el-patch")
|
||||
|
||||
Emacs's runtime and configuration systems are designed to be as flexible as possible, so flexible that it even lets you directly modify the source code of your dependencies.
|
||||
|
||||
... Unfortunately, this means that you are now directly modifying the source code of your dependencies. This can get very messy without proper precautions, and while Emacs provides limited tools like the advising system, they don't always have enough flexibility to get the job done. The package =el-patch= exists as a more powerful alternative.
|
||||
|
||||
#+begin_src emacs-lisp :tangle packages.el :exports none
|
||||
;; -*- no-byte-compile: t; -*-
|
||||
#+end_src
|
||||
|
||||
#+begin_src emacs-lisp :tangle packages.el
|
||||
(package! el-patch)
|
||||
|
||||
(after! el-patch
|
||||
(setq el-patch-warn-on-eval-template nil))
|
||||
#+end_src
|
||||
|
||||
The package allows you to define /patches/ which modify the definitions of functions in systematic ways. The suite of tools provided by the package is easily comprehensive enough for my needs, but we can make the API a bit nicer with some macros:
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defmacro defpatch! (feature type-name &rest args)
|
||||
"Define a patch over something defined in FEATURE."
|
||||
(declare (doc-string 4) (indent 3))
|
||||
(let* ((el-patch (intern (format "el-patch-%s" (car type-name))))
|
||||
(patch `(,el-patch ,(cadr type-name) ,@args)))
|
||||
(if feature
|
||||
`(progn
|
||||
(el-patch-feature ,feature)
|
||||
(after! ,feature
|
||||
,patch))
|
||||
patch)))
|
||||
|
||||
(defmacro deftemplate! (feature type-name &rest args)
|
||||
"Define a template over something defined in FEATURE."
|
||||
(declare (doc-string 3) (indent 2))
|
||||
(let* ((template `(el-patch-define-and-eval-template ,type-name ,@args)))
|
||||
(if feature
|
||||
`(progn
|
||||
(el-patch-feature ,feature)
|
||||
(after! ,feature
|
||||
,template))
|
||||
template)))
|
||||
#+end_src
|
||||
|
||||
** Automated Nix Builds
|
||||
|
||||
#+call: confpkg("Support: Nix")
|
||||
|
||||
Some packages in this config such as =treemacs=, =org-roam=, etc. require certain tools to be in the environment. On a Nix-based system, there are a few different ways to handle this:
|
||||
|
||||
1. Put that tool in the actual environment, e.g. in a profile. This makes sense for simple things (=ripgrep=, =sqlite=, etc) but for more opinionated things like an instance of Python it becomes less desirable.
|
||||
2. Build the tool and put a symlink to the output somewhere, e.g. in the HOME directory. This avoids polluting the environment, but you still have to deal with an unwieldy symlink that breaks Emacs if you accidentally delete it.
|
||||
This was my approach before coming up with the third option:
|
||||
3. Build the tool and point Emacs directly to the store path. This is the most automatic solution, but requires the most complex Emacs configuration.
|
||||
|
||||
This section is an implementation of that third solution.
|
||||
|
||||
We first need a function to build a flake reference:
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defun nix-build-out-path (out &optional impure)
|
||||
"Build the given flake output OUT and return the output path. Return
|
||||
nil if the build fails.
|
||||
|
||||
If IMPURE is t, then allow impure builds."
|
||||
(require 'nix) (require 's)
|
||||
(with-temp-message (format "Building \"%s\" ..." out)
|
||||
(with-temp-buffer
|
||||
(let* ((args `("build" "--no-link" "--print-out-paths"
|
||||
,@(when impure '("--impure")) ,out))
|
||||
(status (apply #'call-process nix-executable nil
|
||||
(list (current-buffer) nil) nil args)))
|
||||
(when (eql status 0)
|
||||
(s-trim (buffer-string)))))))
|
||||
#+end_src
|
||||
|
||||
This works if we just want to start a build, but there's a problem: we haven't indicated to Nix that we're using this output for something, so it will be deleted the next time we garbage collect. To fix this, we can write a wrapper function that also makes the output path a garbage collection root.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defun nix-build-out-path-gcroot (name out &optional impure)
|
||||
"Build the given flake output OUT, register its output path as
|
||||
a garbage collection root under NAME, and return the output path.
|
||||
Return nil if the build fails.
|
||||
|
||||
The GC root is placed under \"/nix/var/nix/gcroots/emacs/NAME\". If
|
||||
a call to this function reuses the same NAME argument, then the
|
||||
symlink is overwritten.
|
||||
|
||||
If IMPURE is t, then allow impure builds."
|
||||
(when-let* ((path (nix-build-out-path out impure))
|
||||
(gcdir "/nix/var/nix/gcroots/emacs")
|
||||
(sym (expand-file-name name gcdir)))
|
||||
(unless (equal path (file-symlink-p sym))
|
||||
(require 'tramp)
|
||||
(make-directory (concat "/sudo::" gcdir) t)
|
||||
(make-symbolic-link path (concat "/sudo::" sym) t))
|
||||
path))
|
||||
#+end_src
|
||||
|
||||
* Doom Modules
|
||||
|
||||
One of Doom Emacs's most useful features is its modular configuration system, allowing configuration code to be sectioned into modules that can be enabled or customized individually. Doom provides a full suite of prewritten modules to enable.
|
||||
|
@ -1203,61 +1308,6 @@ If PARENTS is non-nil, the parents of the specified directory will also be creat
|
|||
"i i" #'nerd-icons-insert)
|
||||
#+end_src
|
||||
|
||||
** Automated Nix Builds
|
||||
|
||||
#+call: confpkg("Nix")
|
||||
|
||||
Some packages in this config such as =treemacs=, =org-roam=, etc. require certain tools to be in the environment. On a Nix-based system, there are a few different ways to handle this:
|
||||
|
||||
1. Put that tool in the actual environment, e.g. in a profile. This makes sense for simple things (=ripgrep=, =sqlite=, etc) but for more opinionated things like an instance of Python it becomes less desirable.
|
||||
2. Build the tool and put a symlink to the output somewhere, e.g. in the HOME directory. This avoids polluting the environment, but you still have to deal with an unwieldy symlink that breaks Emacs if you accidentally delete it.
|
||||
This was my approach before coming up with the third option:
|
||||
3. Build the tool and point Emacs directly to the store path. This is the most automatic solution, but requires the most complex Emacs configuration.
|
||||
|
||||
This section is an implementation of that third solution.
|
||||
|
||||
We first need a function to build a flake reference:
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defun nix-build-out-path (out &optional impure)
|
||||
"Build the given flake output OUT and return the output path. Return
|
||||
nil if the build fails.
|
||||
|
||||
If IMPURE is t, then allow impure builds."
|
||||
(require 'nix) (require 's)
|
||||
(with-temp-message (format "Building \"%s\" ..." out)
|
||||
(with-temp-buffer
|
||||
(let* ((args `("build" "--no-link" "--print-out-paths"
|
||||
,@(when impure '("--impure")) ,out))
|
||||
(status (apply #'call-process nix-executable nil
|
||||
(list (current-buffer) nil) nil args)))
|
||||
(when (eql status 0)
|
||||
(s-trim (buffer-string)))))))
|
||||
#+end_src
|
||||
|
||||
This works if we just want to start a build, but there's a problem: we haven't indicated to Nix that we're using this output for something, so it will be deleted the next time we garbage collect. To fix this, we can write a wrapper function that also makes the output path a garbage collection root.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defun nix-build-out-path-gcroot (name out &optional impure)
|
||||
"Build the given flake output OUT, register its output path as
|
||||
a garbage collection root under NAME, and return the output path.
|
||||
Return nil if the build fails.
|
||||
|
||||
The GC root is placed under \"/nix/var/nix/gcroots/emacs/NAME\". If
|
||||
a call to this function reuses the same NAME argument, then the
|
||||
symlink is overwritten.
|
||||
|
||||
If IMPURE is t, then allow impure builds."
|
||||
(when-let* ((path (nix-build-out-path out impure))
|
||||
(gcdir "/nix/var/nix/gcroots/emacs")
|
||||
(sym (expand-file-name name gcdir)))
|
||||
(unless (equal path (file-symlink-p sym))
|
||||
(require 'tramp)
|
||||
(make-directory (concat "/sudo::" gcdir) t)
|
||||
(make-symbolic-link path (concat "/sudo::" sym) t))
|
||||
path))
|
||||
#+end_src
|
||||
|
||||
* Aesthetics
|
||||
|
||||
#+call: confpkg("Visual")
|
||||
|
@ -1427,14 +1477,6 @@ We should also declutter some other aspects of the dashboard. Since the dashboar
|
|||
|
||||
Now that we've enabled our preferred modules and done some basic configuration, we can install and configure our packages.
|
||||
|
||||
Our ~package!~ declarations go in ~packages.el~, which must not be byte-compiled:
|
||||
|
||||
#+begin_src emacs-lisp :tangle packages.el
|
||||
;; -*- no-byte-compile: t; -*-
|
||||
#+end_src
|
||||
|
||||
Everything else goes in ~config.el~, which is managed by [[*=confpkg=][confpkg]] as outlined earlier.
|
||||
|
||||
** Corfu
|
||||
|
||||
#+call: confpkg("Pkg: corfu")
|
||||
|
@ -1541,23 +1583,22 @@ The provided action types related to programming only apply to Emacs Lisp code,
|
|||
|
||||
*** Hooks
|
||||
|
||||
The hook ~embark--mark-target~ normally sets the mark to the end and puts the point at the beginning. This is the opposite of the usual order, so let's override it to flip the order.
|
||||
The hook ~embark--mark-target~ normally sets the mark to the end and puts the point at the beginning. This is the opposite of the usual order, so let's patch it to flip the order.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(after! embark
|
||||
(cl-defun embark--mark-target (&rest rest &key run bounds &allow-other-keys)
|
||||
(defpatch! embark (cl-defun embark--mark-target) (&rest rest &key run bounds &allow-other-keys)
|
||||
"Mark the target if its BOUNDS are known.
|
||||
After marking the target, call RUN with the REST of its arguments."
|
||||
(cond
|
||||
((and bounds run)
|
||||
(save-mark-and-excursion
|
||||
(set-mark (car bounds))
|
||||
(goto-char (cdr bounds))
|
||||
(set-mark ((el-patch-swap cdr car) bounds))
|
||||
(goto-char ((el-patch-swap car cdr) bounds))
|
||||
(apply run :bounds bounds rest)))
|
||||
(bounds ;; used as pre- or post-action hook
|
||||
(set-mark (car bounds))
|
||||
(goto-char (cdr bounds)))
|
||||
(run (apply run rest)))))
|
||||
(bounds
|
||||
(set-mark ((el-patch-swap cdr car) bounds))
|
||||
(goto-char ((el-patch-swap car cdr) bounds)))
|
||||
(run (apply run rest))))
|
||||
#+end_src
|
||||
|
||||
*** Actions
|
||||
|
@ -2146,31 +2187,53 @@ When editing a snippet, the binding =C-c C-t= can be used to test it in a fresh
|
|||
Doom's command to create a new snippet, ~+snippets/new~, defines a template inside of itself purely for when creating a snippet through this command. This doesn't make much sense to me when file templates already exist as a standard system in Doom, and snippets are stored inside files!
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/snippets-new (&optional all-modes)
|
||||
"Use standard Doom Emacs file template system when creating a new snippet."
|
||||
:override #'+snippets/new
|
||||
(defpatch! nil
|
||||
(defun +snippets/new) (&optional all-modes)
|
||||
"Create a new snippet in `+snippets-dir'.
|
||||
|
||||
If there are extra yasnippet modes active, or if ALL-MODES is non-nil, you will
|
||||
be prompted for the mode for which to create the snippet."
|
||||
(interactive "P")
|
||||
(let* ((mode (+snippets--snippet-mode-name-completing-read all-modes))
|
||||
(default-directory (+snippet--ensure-dir (expand-file-name mode +snippets-dir)))
|
||||
(snippet-key (read-string "Enter a key for the snippet: "))
|
||||
(snippet-file-name (expand-file-name snippet-key)))
|
||||
(when (+snippets--use-snippet-file-name-p snippet-file-name)
|
||||
(find-file snippet-file-name))))
|
||||
(el-patch-swap
|
||||
(with-current-buffer (switch-to-buffer snippet-key)
|
||||
(snippet-mode)
|
||||
(erase-buffer)
|
||||
(set-visited-file-name snippet-file-name)
|
||||
(yas-expand-snippet (concat "# -*- mode: snippet -*-\n"
|
||||
"# name: $1\n"
|
||||
"# uuid: $2\n"
|
||||
"# key: ${3:" snippet-key "}${4:\n"
|
||||
"# condition: t}\n"
|
||||
"# --\n"
|
||||
"$0"))
|
||||
(when (bound-and-true-p evil-local-mode)
|
||||
(evil-insert-state)))
|
||||
(find-file snippet-file-name)))))
|
||||
#+end_src
|
||||
|
||||
*** File Templates
|
||||
|
||||
Doom's =file-templates= module extends =yasnippet= to provide a nice file template system. The idea is simple: the variable ~+file-templates-alist~ maps file predicates to snippets. If a file that matches a predicate is created, the corresponding snippet is automatically expanded inside of it.
|
||||
|
||||
This system works well for the most part, but there's a serious issue with its UI: the function that registers file templates, ~set-file-templates!~, takes a plist to configure the template. If this list is empty, an existing template is removed instead. This is not only unintuitive, but it prevents you from having an empty property list, which is often necessary! We'll advise the function to remove this issue with a =:remove= key, as well as to have templates appended to the alist instead of prepended to make the order of templates more clear.
|
||||
This system works well for the most part, but there's a serious issue with its UI: the function that registers file templates, ~set-file-templates!~, takes a plist to configure the template. If this list is empty, an existing template is removed instead. This is not only unintuitive, but it prevents you from having an empty property list, which is often necessary! We'll patch the function to remove this issue with a =:remove= key, as well as to have templates appended to the alist instead of prepended to make the order of templates more clear.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/file-templates-set (pred plist)
|
||||
:override #'+file-templates--set
|
||||
(if (plist-member plist :remove)
|
||||
(defpatch! nil
|
||||
(defun +file-templates--set) (pred plist)
|
||||
(if (el-patch-swap (null (car-safe plist))
|
||||
(plist-member plist :remove))
|
||||
(setq +file-templates-alist
|
||||
(assoc-delete-all pred +file-templates-alist))
|
||||
(el-patch-swap (delq (assoc pred +file-templates-alist) +file-templates-alist)
|
||||
(assoc-delete-all pred +file-templates-alist)))
|
||||
(el-patch-swap
|
||||
(push `(,pred ,@plist) +file-templates-alist)
|
||||
(setq +file-templates-alist
|
||||
(nconc +file-templates-alist `((,pred ,@plist))))))
|
||||
(nconc +file-templates-alist `((,pred ,@plist)))))))
|
||||
#+end_src
|
||||
|
||||
Now that we have our new-and-improved template registry system, we can add new file templates as we please.
|
||||
|
@ -2472,9 +2535,8 @@ Emacs Everywhere is a great idea. Unfortunately, the default package on MELPA us
|
|||
'("hyprctl" "dispatch" "focuswindow" "address:%w")))
|
||||
|
||||
;; Function for accessing current window
|
||||
(defadvice! ~/emacs-everywhere-app-info-hyprland ()
|
||||
"Return information on the active window, in Hyprland."
|
||||
:override #'emacs-everywhere--app-info-linux
|
||||
(defun emacs-everywhere--app-info-linux-hyprland ()
|
||||
"Return information on the active window, on Hyprland."
|
||||
(pcase-let*
|
||||
((`(,window-id ,window-class ,window-title . ,window-dims-)
|
||||
(split-string (shell-command-to-string
|
||||
|
@ -2487,6 +2549,17 @@ Emacs Everywhere is a great idea. Unfortunately, the default package on MELPA us
|
|||
:class window-class
|
||||
:title window-title
|
||||
:geometry window-dims)))
|
||||
|
||||
(defpatch! emacs-everywhere
|
||||
(defun emacs-everywhere--app-info-linux) ()
|
||||
"Return information on the active window, on Linux."
|
||||
(pcase emacs-everywhere--display-server
|
||||
(`(x11 . ,_) (emacs-everywhere--app-info-linux-x11))
|
||||
(`(wayland . KDE) (emacs-everywhere--app-info-linux-kde))
|
||||
(el-patch-add
|
||||
(`(wayland . Hyprland) (emacs-everywhere--app-info-linux-hyprland)))
|
||||
(_ (user-error "Unable to fetch app info with display server %S"
|
||||
emacs-everywhere--display-server))))
|
||||
#+end_src
|
||||
|
||||
** Mail
|
||||
|
@ -2540,27 +2613,38 @@ I use the standard Unix-style password management system, [[https://www.password
|
|||
For some unknown reason, the creators of the original =pass= package decided that when showing the pass buffer, the main dispatch function would call ~pop-to-buffer~ when it needs to be created, but ~switch-to-buffer~ when it already exists. These are different functions! Let's fix that.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/pass ()
|
||||
"Fix inconsistent opening of `pass-mode' buffer."
|
||||
:override #'pass
|
||||
(if-let ((window (get-buffer-window pass-buffer-name)))
|
||||
(defpatch! pass
|
||||
(defun pass) ()
|
||||
"Open the password-store buffer."
|
||||
(interactive)
|
||||
((el-patch-swap if if-let)
|
||||
(el-patch-swap (get-buffer pass-buffer-name)
|
||||
((window (get-buffer-window pass-buffer-name))))
|
||||
(progn
|
||||
(select-window window)
|
||||
(el-patch-swap (switch-to-buffer pass-buffer-name)
|
||||
(select-window window))
|
||||
(pass-update-buffer))
|
||||
(pop-to-buffer pass-buffer-name)
|
||||
(pass-setup-buffer)))
|
||||
(el-patch-add (pop-to-buffer pass-buffer-name))
|
||||
(el-patch-splice 3
|
||||
(let ((buf (get-buffer-create pass-buffer-name)))
|
||||
(pop-to-buffer buf)
|
||||
(pass-setup-buffer)))))
|
||||
#+end_src
|
||||
|
||||
When visiting a password file, the file's buffer replaces the pass buffer, which isn't very good UX. To fix this, we can advise it to use ~pop-to-buffer~, folding it into the popup system.
|
||||
When visiting a password file, the file's buffer replaces the pass buffer, which isn't very good UX. To fix this, we can patch it to use ~pop-to-buffer~, folding it into the popup system.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/pass-view ()
|
||||
"Use `find-file-other-window' instead of `find-file'."
|
||||
:override #'pass-view
|
||||
(defpatch! pass
|
||||
(defun pass-view) ()
|
||||
"Visit the entry at point."
|
||||
(interactive)
|
||||
(pass--with-closest-entry entry
|
||||
(el-patch-let (($file (concat (f-join (password-store-dir) entry) ".gpg")))
|
||||
(el-patch-swap
|
||||
(find-file $file)
|
||||
(pop-to-buffer
|
||||
(find-file-noselect (concat (f-join (password-store-dir) entry) ".gpg"))
|
||||
(cdr (+popup-make-rule nil '(:side bottom :size 8 :quit t :modeline t))))))
|
||||
(find-file-noselect $file)
|
||||
(cdr (+popup-make-rule nil '(:side bottom :size 8 :quit t :modeline t))))))))
|
||||
#+end_src
|
||||
|
||||
* Org
|
||||
|
@ -3159,10 +3243,11 @@ I don't want to have to specify the =RESET_CHECK_BOXES= property for every TODO
|
|||
(after! org-checklist
|
||||
(push '("RESET_CHECK_BOXES" . "t") org-global-properties))
|
||||
|
||||
(defadvice! ~/org-checklist-reset-inherit ()
|
||||
"Override checkbox resetting to use property inheritance."
|
||||
:override #'org-reset-checkbox-state-maybe
|
||||
(if (org-entry-get (point) "RESET_CHECK_BOXES" t)
|
||||
(defpatch! org-checklist
|
||||
(defun org-reset-checkbox-state-maybe) ()
|
||||
"Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set"
|
||||
(interactive "*")
|
||||
(if (org-entry-get (point) "RESET_CHECK_BOXES" (el-patch-add t))
|
||||
(org-reset-checkbox-state-subtree)))
|
||||
#+end_src
|
||||
|
||||
|
@ -3210,41 +3295,40 @@ This works fine for explicitly displaying inline images. However, toggling using
|
|||
|
||||
The command ~+org/dwim-at-point~ will toggle all overlays in a subtree even if there are other actions that are more likely to be what the user meant (such as marking as DONE). We also need to change the interaction with links to properly account for whether the link has a description.
|
||||
|
||||
Annoyingly, the only good way to fix these issues is to completely override the extremely long function.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/org-dwim (old-fn &optional arg)
|
||||
"Various tweaks to the function of the DWIM command."
|
||||
:override #'+org/dwim-at-point
|
||||
(deftemplate! org (defun +org/dwim-at-point)
|
||||
"Do-what-I-mean at point.
|
||||
|
||||
If on a:
|
||||
- checkbox list item or todo heading: toggle it.
|
||||
- citation: follow it
|
||||
- headline: cycle ARCHIVE subtrees, toggle latex fragments and inline images in
|
||||
subtree; update statistics cookies/checkboxes and ToCs.
|
||||
- clock: update its time.
|
||||
- footnote reference: jump to the footnote's definition
|
||||
- footnote definition: jump to the first reference of this footnote
|
||||
- timestamp: open an agenda view for the time-stamp date/range at point.
|
||||
- table-row or a TBLFM: recalculate the table's formulas
|
||||
- table-cell: clear it and go into insert mode. If this is a formula cell,
|
||||
recaluclate it instead.
|
||||
- babel-call: execute the source block
|
||||
- statistics-cookie: update it.
|
||||
- src block: execute it
|
||||
- latex fragment: toggle it.
|
||||
- link: follow it
|
||||
- otherwise, refresh all inline images in current tree."
|
||||
(interactive "P")
|
||||
(if (button-at (point))
|
||||
(call-interactively #'push-button)
|
||||
(let* ((context (org-element-context))
|
||||
(type (org-element-type context)))
|
||||
(while (and context (memq type '(verbatim code bold italic underline strike-through subscript superscript)))
|
||||
(while (and context (memq type '(verbatim code bold italic underline
|
||||
strike-through subscript superscript)))
|
||||
(setq context (org-element-property :parent context)
|
||||
type (org-element-type context)))
|
||||
(pcase type
|
||||
((or `citation `citation-reference)
|
||||
(org-cite-follow context arg))
|
||||
(`headline
|
||||
(cond ((memq (bound-and-true-p org-goto-map)
|
||||
(current-active-maps))
|
||||
(org-goto-ret))
|
||||
((and (fboundp 'toc-org-insert-toc)
|
||||
(member "TOC" (org-get-tags)))
|
||||
(toc-org-insert-toc)
|
||||
(message "Updating table of contents"))
|
||||
((string= "ARCHIVE" (car-safe (org-get-tags)))
|
||||
(org-force-cycle-archived))
|
||||
((or (org-element-property :todo-type context)
|
||||
(org-element-property :scheduled context))
|
||||
(org-todo
|
||||
(if (eq (org-element-property :todo-type context) 'done)
|
||||
(or (car (+org-get-todo-keywords-for (org-element-property :todo-keyword context)))
|
||||
'todo)
|
||||
'done)))
|
||||
(t
|
||||
(let* ((beg (if (org-before-first-heading-p)
|
||||
...
|
||||
(el-patch-let (($latex (let* ((beg (if (org-before-first-heading-p)
|
||||
(line-beginning-position)
|
||||
(save-excursion (org-back-to-heading) (point))))
|
||||
(end (if (org-before-first-heading-p)
|
||||
|
@ -3252,7 +3336,9 @@ Annoyingly, the only good way to fix these issues is to completely override the
|
|||
(save-excursion (org-end-of-subtree) (point))))
|
||||
(overlays (ignore-errors (overlays-in beg end)))
|
||||
(latex-overlays
|
||||
(cl-find-if (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
|
||||
(cl-find-if (lambda (o)
|
||||
(eq (overlay-get o 'org-overlay-type)
|
||||
'org-latex-overlay))
|
||||
overlays))
|
||||
(image-overlays
|
||||
(cl-find-if (lambda (o) (overlay-get o 'org-image-overlay))
|
||||
|
@ -3261,77 +3347,31 @@ Annoyingly, the only good way to fix these issues is to completely override the
|
|||
(if (or image-overlays latex-overlays)
|
||||
(org-clear-latex-preview beg end)
|
||||
(org--latex-preview-region beg end)))))
|
||||
(org-update-checkbox-count)
|
||||
(org-update-parent-todo-statistics)
|
||||
(when (and (fboundp 'toc-org-insert-toc)
|
||||
(member "TOC" (org-get-tags)))
|
||||
(toc-org-insert-toc)
|
||||
(message "Updating table of contents"))
|
||||
)
|
||||
(`clock (org-clock-update-time-maybe))
|
||||
(`footnote-reference
|
||||
(org-footnote-goto-definition
|
||||
(org-element-property :label context)))
|
||||
(`footnote-definition
|
||||
(org-footnote-goto-previous-reference
|
||||
(org-element-property :label context)))
|
||||
((or `planning `timestamp)
|
||||
(org-follow-timestamp-link))
|
||||
((or `table `table-row)
|
||||
(if (org-at-TBLFM-p)
|
||||
(org-table-calc-current-TBLFM)
|
||||
(ignore-errors
|
||||
(save-excursion
|
||||
(goto-char (org-element-property :contents-begin context))
|
||||
(org-call-with-arg 'org-table-recalculate (or arg t))))))
|
||||
(`table-cell
|
||||
(org-table-blank-field)
|
||||
(org-table-recalculate arg)
|
||||
(when (and (string-empty-p (string-trim (org-table-get-field)))
|
||||
(bound-and-true-p evil-local-mode))
|
||||
(evil-change-state 'insert)))
|
||||
(`babel-call
|
||||
(org-babel-lob-execute-maybe))
|
||||
(`statistics-cookie
|
||||
(save-excursion (org-update-statistics-cookies arg)))
|
||||
((or `src-block `inline-src-block)
|
||||
(org-babel-execute-src-block arg))
|
||||
((or `latex-fragment `latex-environment)
|
||||
(org-latex-preview arg))
|
||||
(`headline
|
||||
(cond ... (el-patch-add (t $latex)))
|
||||
...
|
||||
(el-patch-remove $latex)))
|
||||
...
|
||||
(`link
|
||||
(let* ((lineage (org-element-lineage context '(link) t))
|
||||
(path (org-element-property :path lineage)))
|
||||
(if (or (equal (org-element-property :type lineage) "img")
|
||||
(and path (image-supported-file-p path)
|
||||
(and path (image-type-from-file-name path)
|
||||
(el-patch-add
|
||||
(or +org-inline-image-desc
|
||||
(not (org-element-property :contents-begin lineage)))))
|
||||
(not (org-element-property :contents-begin lineage))))))
|
||||
(+org--toggle-inline-images-in-subtree
|
||||
(org-element-property :begin lineage)
|
||||
(org-element-property :end lineage))
|
||||
(org-open-at-point arg))))
|
||||
((guard (org-element-property :checkbox (org-element-lineage context '(item) t)))
|
||||
(org-toggle-checkbox)
|
||||
(unless arg
|
||||
(org-next-item)
|
||||
(beginning-of-line)
|
||||
(re-search-forward "\\[.\\] ")))
|
||||
(`paragraph
|
||||
(+org--toggle-inline-images-in-subtree))
|
||||
(_
|
||||
(if (or (org-in-regexp org-ts-regexp-both nil t)
|
||||
(org-in-regexp org-tsr-regexp-both nil t)
|
||||
(org-in-regexp org-link-any-re nil t))
|
||||
(call-interactively #'org-open-at-point)
|
||||
(+org--toggle-inline-images-in-subtree
|
||||
(org-element-property :begin context)
|
||||
(org-element-property :end context))))))))
|
||||
...))))
|
||||
#+end_src
|
||||
|
||||
*** Default Categories
|
||||
|
||||
When an explicit category is not specified, Org mode typically defaults to the filename (sans extension). This ... sort of makes sense? I guess? It doesn't really, because filename conventions don't make for good agenda category names. I want my category names to be in title case, whereas a file name is typically going to be all lowercase and without spaces. This is especially bad for Org-roam, where filenames are automatically generated and way too long to be a UI element.
|
||||
|
||||
To fix this issue, it's... "easy" to patch Org-mode's category system. The following code sets things up so that the file's =#+title= metadata is used as the default category, falling back on the default behavior if a title is not given.
|
||||
To fix this issue, it's thankfully rather simple to patch Org-mode's category system. The following code sets things up so that the file's =#+title= metadata is used as the default category, falling back on the default behavior if a title is not given.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(defadvice! ~/org-default-category (old-fn)
|
||||
|
@ -3553,17 +3593,27 @@ Now we just have to advise Org-roam with the proper logic!
|
|||
(let ((org-roam-capture-templates (list org-roam-capture-default-template)))
|
||||
(apply old-fn args)))
|
||||
|
||||
(cl-defun ~/org-roam-capture (&optional goto keys &key filter-fn templates info)
|
||||
(defpatch! org-roam
|
||||
(cl-defun org-roam-capture) (&optional goto keys &key filter-fn templates info)
|
||||
"Launches an `org-capture' process for a new or existing node.
|
||||
This uses the templates defined at `org-roam-capture-templates'.
|
||||
Arguments GOTO and KEYS see `org-capture'.
|
||||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||||
and when nil is returned the node will be filtered out.
|
||||
The TEMPLATES, if provided, override the list of capture templates (see
|
||||
`org-roam-capture-'.)
|
||||
The INFO, if provided, is passed along to the underlying `org-roam-capture-'."
|
||||
(interactive "P")
|
||||
(let ((node (org-roam-node-read nil filter-fn)))
|
||||
(org-roam-capture- :goto goto
|
||||
:info info
|
||||
:keys keys
|
||||
:templates (or templates
|
||||
:templates (el-patch-wrap 1 1
|
||||
(or templates
|
||||
(when (org-roam-node-file node)
|
||||
org-roam-capture-existing-templates))
|
||||
org-roam-capture-existing-templates)))
|
||||
:node node
|
||||
:props '(:immediate-finish nil))))
|
||||
(advice-add #'org-roam-capture :override #'~/org-roam-capture)
|
||||
|
||||
(defadvice! ~/org-roam-dailies-default-capture (old-fn time &optional goto keys)
|
||||
"Use default capture template when not explicitly capturing."
|
||||
|
@ -3712,20 +3762,31 @@ This "overview" agenda command is very nice. It's so nice, in fact, that it's al
|
|||
|
||||
*** TODO Tweaks
|
||||
|
||||
When finding a node with ~org-roam-node-find~, the universal argument to open it in another window doesn't work when the node is new. We can fix this with an override:
|
||||
When finding a node with ~org-roam-node-find~, the universal argument to open it in another window doesn't work when the node is new. We can fix this with a patch:
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(cl-defun ~/org-roam-node-find (&optional other-window initial-input filter-fn pred &key templates)
|
||||
(defpatch! org-roam
|
||||
(cl-defun org-roam-node-find) (&optional other-window initial-input filter-fn pred
|
||||
&key templates)
|
||||
"Find and open an Org-roam node by its title or alias.
|
||||
INITIAL-INPUT is the initial input for the prompt.
|
||||
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
|
||||
and when nil is returned the node will be filtered out.
|
||||
If OTHER-WINDOW, visit the NODE in another window.
|
||||
The TEMPLATES, if provided, override the list of capture templates (see
|
||||
`org-roam-capture-'.)"
|
||||
(interactive current-prefix-arg)
|
||||
(let ((node (org-roam-node-read initial-input filter-fn pred)))
|
||||
(if (org-roam-node-file node)
|
||||
(org-roam-node-visit node other-window)
|
||||
(org-roam-capture-
|
||||
:node node
|
||||
:templates (or templates (list org-roam-capture-default-template))
|
||||
:props (if other-window
|
||||
:templates (el-patch-wrap 1 1
|
||||
(or templates (list org-roam-capture-default-template)))
|
||||
:props (el-patch-wrap 3
|
||||
(if other-window
|
||||
'(:after-finalize find-file-other-window)
|
||||
'(:finalize find-file))))))
|
||||
(advice-add #'org-roam-node-find :override #'~/org-roam-node-find)
|
||||
'(:finalize find-file)))))))
|
||||
#+end_src
|
||||
|
||||
** Citations
|
||||
|
|
Loading…
Reference in a new issue