Sacha Chua's Emacs configuration
Last exported: 2024-12-02 20:42
About this file
This is my personal config. It's really long, but that's partly because I sometimes leave blog posts in it as commentary, and also because I've got a lot of little customizations that I might not even remember. =) If you want to see a table of contents and other useful niceties, go to http://sachachua.com/dotemacs . Other links for this page: Org Mode version, Github repository
If you're new to Emacs Lisp, you probably don't want to copy and paste
large chunks of this code. Instead, copy small parts of it (always
making sure to copy a complete set of parentheses) into your
*scratch*
buffer or some other buffer in emacs-lisp-mode
. Use M-x
eval-buffer
to evaluate the code and see if you like the way that
Emacs behaves. See An Introduction to Programming in Emacs Lisp for
more details on Emacs Lisp. You can also find the manual by using C-h
i
(info
) and choosing "Emacs Lisp Intro".
I've installed a lot of packages. See the section to
add the repositories to your configuration. When you see use-package
and a package name you might like, you can use M-x package-install
to install the package of that name.
If you're viewing the Org file, you can open source code blocks (those
are the ones in begin_src
) in a separate buffer by moving your point
inside them and typing C-c '
(org-edit-special
). This opens another
buffer in emacs-lisp-mode
, so you can use M-x eval-buffer
to load
the changes. If you want to explore how functions work, use M-x
edebug-defun
to set up debugging for that function, and then call it.
You can learn more about edebug in the Emacs Lisp manual.
I like using (setq ...)
more than Customize because I can neatly
organize my configuration that way. Ditto for use-package
- I mostly
use it to group together package-related config without lots of
with-eval-after-load
calls, and it also makes declaring keybindings
easier.
Here's my init.el:
(load-file "~/sync/emacs/Sacha.el") (load-file "~/sync/cloud/.emacs.secrets") (put 'narrow-to-region 'disabled nil) (put 'list-timers 'disabled nil) (server-mode 1)
Sacha.el is what M-x org-babel-tangle
(C-c C-v t
) produces.
A note about Org updates: I like running Org Mode from checked-out
source code instead of package.el. I add the Lisp directories to my
load-path
, and I also use the :load-path
option in my first
use-package org
call to set the load path. One of those is probably
doing the trick and the other one is redundant, but maybe it's a
belt-and-suspenders sort of thing. Using the git checkout also makes
upgrading Org easy. All I have to do is git pull; make
, and stuff
happens in an external Emacs process. Since I create Sacha.el
via
org-babel-tangle
, my Emacs config can load Sacha.el
without
loading Org first.
Debugging tips
If things break, I can use:
check-parens
to look for mismatched parentheses- bug-hunter to bisect my configuration
trace-function-background
to get information printed to a bufferprofiler-start
to find out more about slow functions
Starting up
Here's how we start:
;; -*- lexical-binding: t -*- ;; This sets up the load path so that we can override it (setq warning-suppress-log-types '((package reinitialization))) (package-initialize) (add-to-list 'load-path "/usr/local/share/emacs/site-lisp") (add-to-list 'load-path "~/vendor/org-mode/lisp") (add-to-list 'load-path "~/vendor/org-mode/contrib/lisp") (setq custom-file "~/.config/emacs/custom-settings.el") (setq use-package-always-ensure t) (load custom-file t)
Emacs initialization
Add package sources
(unless (assoc-default "melpa" package-archives) (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)) (unless (assoc-default "nongnu" package-archives) (add-to-list 'package-archives '("nongnu" . "https://elpa.nongnu.org/nongnu/") t))
Use M-x package-refresh-contents
to reload the list of packages
after adding these for the first time.
Add my elisp directory and other files
Sometimes I load files outside the package system. As long as they're
in a directory in my load-path
, Emacs can find them.
(add-to-list 'load-path "~/elisp") (setq use-package-verbose t) (setq use-package-always-ensure t) (require 'use-package) (use-package quelpa) (use-package quelpa-use-package) (quelpa-use-package-activate-advice) (setq load-prefer-newer t)
Personal information
(setq user-full-name "Sacha Chua" user-mail-address "sacha@sachachua.com")
System information
(defvar my-laptop-p (or (equal (system-name) "sacha-x230") (equal (system-name) "sacha-p52"))) (defvar my-server-p (and (equal (system-name) "localhost") (equal user-login-name "sacha"))) (defvar my-phone-p (not (null (getenv "ANDROID_ROOT"))) "If non-nil, GNU Emacs is running on Termux.") (when my-phone-p (setq gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3")) (global-auto-revert-mode) ; simplifies syncing
Reload
(defun my-reload-emacs-configuration () (interactive) (load-file "~/proj/.emacs.d/Sacha.el"))
Backups
This is one of the things people usually want to change right away. By default, Emacs saves backup files in the current directory. These are the files ending in ~
that are cluttering up your directory lists. The following code stashes them all in ~/.config/emacs/backups
, where I can find them with C-x C-f
(find-file
) if I really need to.
(setq backup-directory-alist '(("." . "~/.config/emacs/backups"))) (with-eval-after-load 'tramp (setq tramp-backup-directory-alist nil))
Disk space is cheap. Save lots.
(setq delete-old-versions -1) (setq version-control t) (setq vc-make-backup-files t) (setq auto-save-file-name-transforms '((".*" "~/.config/emacs/auto-save-list/" t)))
History
From http://www.wisdomandwonder.com/wp-content/uploads/2014/03/C3F.html:
(setq savehist-file "~/.config/emacs/savehist") (savehist-mode 1) (setq history-length t) (setq history-delete-duplicates t) (setq savehist-save-minibuffer-history 1) (setq savehist-additional-variables '(kill-ring search-ring regexp-search-ring))
Disabling the toolbar
When you're starting out, the tool bar can be very helpful. (Emacs Basics: Using the Mouse). Eventually, you may want to reclaim that extra little bit of screenspace. The following code turns that thing off. (Although I changed my mind about the menu - I want that again.)
(tool-bar-mode -1)
Change "yes or no" to "y or n"
Lazy people like me never want to type "yes" when "y" will suffice.
(fset 'yes-or-no-p 'y-or-n-p)
Minibuffer editing - more space!
Sometimes you want to be able to do fancy things with the text
that you're entering into the minibuffer. Sometimes you just want
to be able to read it, especially when it comes to lots of text.
This binds C-M-e
in a minibuffer) so that you can edit the
contents of the minibuffer before submitting it.
(use-package miniedit :commands minibuffer-edit :init (miniedit-install))
Killing text
(setq kill-ring-max 1000)
From https://github.com/itsjeyd/emacs-config/blob/emacs24/init.el
(defadvice kill-region (before slick-cut activate compile) "When called interactively with no active region, kill a single line instead." (interactive (if mark-active (list (region-beginning) (region-end)) (list (line-beginning-position) (line-beginning-position 2)))))
Keybindings
(repeat-mode 1)
Embark
(use-package embark :after org :load-path "~/vendor/embark" ; :quelpa (embark :fetcher github :repo "oantolin/embark") :config (setq embark-prompter 'embark-keymap-prompter) (add-to-list 'embark-target-finders 'my-embark-org-element) (add-to-list 'embark-target-finders 'my-embark-subed-timestamp) (add-to-list 'embark-target-injection-hooks '(my-journal-post embark--allow-edit)) (with-eval-after-load 'subed (defvar-keymap embark-subed-timestamp-actions :doc "Subed timestamp actions" :parent subed-mode-map "." #'my-subed-set-timestamp-to-mpv-position "c" #'my-subed-copy-timestamp-dwim "<up>" #'my-subed-adjust-timestamp/my-subed-adjust-timestamp-up "w" #'my-waveform-subed-show-after-time "<down>" #'my-subed-adjust-timestamp/my-subed-adjust-timestamp-down)) (defvar-keymap embark-sketch-actions :doc "Org Mode sketch-related actions" :parent org-mode-map "o" #'my-sketch-insert-file-as-link "i" #'my-sketch-insert-file-as-link "v" #'my-geeqie-view) (defvar-keymap embark-journal-actions :doc "Journal" "e" #'my-journal-edit) (add-to-list 'embark-keymap-alist '(sketch . embark-sketch-actions)) (add-to-list 'embark-keymap-alist '(subed-timestamp . embark-subed-timestamp-actions)) (add-to-list 'embark-keymap-alist '(journal . embark-journal-actions)) :bind (("C-." . embark-act) ("C-;" . embark-act) :map vertico-map (("M-e" . embark-export)) :map minibuffer-local-map (("C-c e" . embark-act) ("M-e" . embark-export) ("C-;" . embark-act) ("C-<tab>" . embark-select) ("C-SPC" . (lambda () (interactive) (embark-select) (vertico-next)))) :map embark-collect-mode-map (("C-c e" . embark-act) ("C-;" . embark-act) ("C-<tab>" . embark-select)) :map embark-general-map (("j" . my-journal-post) ("m" . my-stream-message) ("M-w" . (lambda (s) (interactive "MString: ") (kill-new s)))) :map embark-symbol-map ("r" . erefactor-rename-symbol-in-buffer) :map embark-url-map ("c" . my-caption-show) )) (with-eval-after-load 'embark-org (define-key embark-org-src-block-map "i" #'my-org-fix-block-indentation))
Things I'm getting used to using:
C-. c
on an Org Mode source block to copy the contents
In addition to the entries below, I also have Embark-related code in other places in my config:
- Insert a link to an Org Mode heading from an org-refile prompt
- consult-omni
- Quickly jump to positions
- Making it easier to add a category to a blog post
- embark-11ty
- Using an Emacs Lisp macro to define quick custom Org Mode links to project files; plus URLs and search (2024)
- Copy web link
- Quickly search my code
- Tip from Omar: embark-around-action-hooks
- Edit list
- Running the current Org Mode Babel Javascript block from Emacs using Spookfox (2024)
- Act on current message with Embark
Using Embark and qrencode to show a QR code for the Org Mode link at point emacs org
: Added some code to display the QR code on the right side.
John Kitchin includes little QR codes in his videos. I
thought that was a neat touch that makes it easier for
people to jump to a link while they're watching. I'd like to
make it easier to show QR codes too. The following code lets
me show a QR code for the Org link at point. Since many of
my links use custom Org link types that aren't that useful
for people to scan, the code reuses the link resolution code
from web-link so that I can get the regular
https:
link.
(defun my-org-link-qr (url) "Display a QR code for URL in a buffer." (let ((buf (save-window-excursion (qrencode--encode-to-buffer (my-org-stored-link-as-url url))))) (if (> (frame-width) 80) (display-buffer-in-side-window buf '((side . right))) (display-buffer buf)))) (use-package qrencode :config (with-eval-after-load 'embark-org (define-key embark-org-link-map (kbd "q") #'my-org-link-qr)))
TODO Using Embark to act on video
(defun my-embark-video () "Match video." (let ((extensions "youtu\\.?be\\|\\(webm\\|mp4\\|flv\\)$")) (if-let ((link (and (derived-mode-p 'org-mode) (org-element-context)))) (when (eq (org-element-type link) 'link) (cond ((string-match extensions (org-element-property :path link)) (cons 'video (org-element-property :path link))))) (when (and (derived-mode-p 'dired-mode) (string-match extensions (dired-get-filename))) (cons 'video (dired-get-filename)))))) (with-eval-after-load 'embark (add-to-list 'embark-target-finders 'my-embark-video) (defvar-keymap my-embark-video-actions :doc "video" "d" #'my-deepgram-recognize-audio "$" #'my-deepgram-cost "m" #'mpv-play "c" #'my-caption-show "w" #'my-audio-text "W" #'waveform-show) (add-to-list 'embark-keymap-alist '(video . my-embark-video-actions)))
Using Embark to act on audio
(defun my-embark-audio () "Match audio." (let ((extensions "m4a\\|mp3\\|wav\\|ogg\\|opus")) (if-let ((link (and (derived-mode-p 'org-mode) (org-element-context)))) (when (eq (org-element-type link) 'link) (cond ((string-match extensions (org-element-property :path link)) (cons 'audio (org-element-property :path link))))) (when (and (derived-mode-p 'dired-mode) (string-match extensions (dired-get-filename))) (cons 'audio (dired-get-filename)))))) (defun my-audio-text (file &optional insert) "Get the text for FILE audio. If called interactively, copy to the kill ring." (interactive (list (read-file-name "Audio: "))) (let (text) (cond ((file-exists-p (concat (file-name-sans-extension file) ".txt")) (with-temp-buffer (insert-file-contents (concat (file-name-sans-extension file) ".txt")) (setq text (buffer-string)))) ;; no txt yet, is there a vtt? ((file-exists-p (concat (file-name-sans-extension file) ".vtt")) (setq text (subed-subtitle-list-text (subed-parse-file (concat (file-name-sans-extension file) ".vtt"))))) ;; no VTT, let's recognize it (t (my-deepgram-recognize-audio file) (when (file-exists-p (concat (file-name-sans-extension file) ".vtt")) (setq text (subed-subtitle-list-text (subed-parse-file (concat (file-name-sans-extension file) ".vtt"))))))) (when text (when (called-interactively-p 'any) (if insert (insert text "\n") (kill-new text))) text))) (defun my-open-in-audacity (file) (interactive "FFile: ") (start-process "audacity" nil "audacity" file)) (with-eval-after-load 'embark (add-to-list 'embark-target-finders 'my-embark-audio) (defvar-keymap my-embark-audio-actions :doc "audio" "a" #'my-open-in-audacity "d" #'my-deepgram-recognize-audio "$" #'my-deepgram-cost "D" #'my-audio-braindump-reprocess "m" #'mpv-play "w" #'my-audio-text "W" #'waveform-show) (add-to-list 'embark-keymap-alist '(audio . my-embark-audio-actions)))
Using Embark to insert files as Org INCLUDEs
(defun my-insert-file-as-org-include (file) (interactive "fFile: ") (set-text-properties 0 (length file) nil file) (let ((mode (assoc-default file auto-mode-alist 'string-match))) (insert (org-link-make-string (concat "file:" file) (concat "Download " (file-name-nondirectory file))) "\n" "#+begin_my_details " (file-name-nondirectory file) "\n" (format "#+INCLUDE: %s" (prin1-to-string file)) (if mode (concat " src " (replace-regexp-in-string "-mode$" "" (symbol-name mode))) "") "\n" "#+end_my_details\n"))) (defun my-transform-org-link-to-include () (interactive) (let ((link (org-element-lineage (org-element-context) '(link) t)) (mode (assoc-default (org-element-property :path link) auto-mode-alist 'string-match))) (when link (delete-region (org-element-property :begin link) (org-element-property :end link)) (my-insert-file-as-org-include (org-element-property :path link))))) (with-eval-after-load 'embark (define-key embark-file-map "O" #'my-insert-file-as-org-include))
Using Embark to offer context-sensitive actions for Org elements
(defun my-embark-org-element () "Target an Org Mode element at point." (save-window-excursion (save-excursion (save-restriction (when (derived-mode-p 'org-agenda-mode) (org-goto-marker-or-bmk (org-get-at-bol 'org-marker)) (org-back-to-heading)) (when (derived-mode-p 'org-mode) (let* ((context ;; Borrowed from org-open-at-point ;; Only consider supported types, even if they are not the ;; closest one. (org-element-lineage (org-element-context) '(headline src-block link) t)) (type (org-element-type context)) (value (org-element-property :value context))) (cond ((eq type 'headline) (cons 'org-heading (org-element-property :title context))) ((eq type 'src-block) (cons 'org-src-block (org-element-property :name context))) ((eq type 'link) (cons 'url (org-element-property :raw-link context)))))))))) (defun my-embark-org-src-block-copy-noweb-reference (element) (kill-new (if (org-element-property element :parameters) (format "<<%s(%s)>>" (org-element-property element :name) (org-element-property element :parameters)) (format "<<%s>>" (org-element-property element :parameters)))))
Whichkey and Embark
(defun embark-which-key-indicator () "An embark indicator that displays keymaps using which-key. The which-key help message will show the type and value of the current target followed by an ellipsis if there are further targets." (lambda (&optional keymap targets prefix) (if (null keymap) (which-key--hide-popup-ignore-command) (which-key--show-keymap (if (eq (plist-get (car targets) :type) 'embark-become) "Become" (format "Act on %s '%s'%s" (plist-get (car targets) :type) (embark--truncate-target (plist-get (car targets) :target)) (if (cdr targets) "…" ""))) (if prefix (pcase (lookup-key keymap prefix 'accept-default) ((and (pred keymapp) km) km) (_ (key-binding prefix 'accept-default))) keymap) nil nil t (lambda (binding) (not (string-suffix-p "-argument" (cdr binding)))))))) (setq embark-indicators '(embark-which-key-indicator embark-highlight-indicator embark-isearch-highlight-indicator)) (defun embark-hide-which-key-indicator (fn &rest args) "Hide the which-key indicator immediately when using the completing-read prompter." (which-key--hide-popup-ignore-command) (let ((embark-indicators (remq #'embark-which-key-indicator embark-indicators))) (apply fn args))) (with-eval-after-load 'embark (advice-add #'embark-completing-read-prompter :around #'embark-hide-which-key-indicator))
Embark and images image
: added attachment handling
(defun my-sketch-insert-file-as-link (f) (interactive (list (my-complete-sketch-filename))) (cond ((derived-mode-p 'org-mode) (insert (org-link-make-string (concat "sketch:" (file-name-nondirectory f))) "\n")) ((or (derived-mode-p 'html-mode) (derived-mode-p 'web-mode)) (insert "{% sketchFull \"" (file-name-base f) "\" %}")) (t (insert f))))
(defun my-embark-image () "Match images." (let ((extensions "\\(png\\|jpg\\|svg\\|gif\\)\\'")) (if-let ((link (and (derived-mode-p 'org-mode) (org-element-context)))) (when (eq (org-element-type link) 'link) (cond ((string= "attachment" (org-element-property :type link)) (cons 'image (expand-file-name (org-element-property :path link) (org-attach-dir)))) ((string-match "sketch" (org-element-property :type link)) (cons 'image (my-get-sketch-filename (org-element-property :path link)))) ((string-match extensions (org-element-property :path link)) (cons 'image (org-element-property :path link))))) (when (and (derived-mode-p 'dired-mode) (string-match extensions (dired-get-filename))) (cons 'image (dired-get-filename)))))) (with-eval-after-load 'embark (add-to-list 'embark-target-finders 'my-embark-image))
I want to:
- open images in an annotation program, maybe com.github.phase1geo.annotator
- open images in Krita
- replace with latest screenshot
- copy text to kill ring
- insert text as details block
(defun my-image-open-in-annotator (file) (interactive "FImage: ") (start-process "annotator" nil "com.github.phase1geo.annotator" (expand-file-name file))) (defun my-image-open-in-krita (file) (interactive "FImage: ") (start-process "krita" nil "krita" "--nosplash" (expand-file-name file))) (defun my-image-open-in-inkscape (file) (interactive "FImage: ") (start-process "inkscape" nil "inkscape" (expand-file-name file))) (defun my-image-open-in-gimp (file) (interactive "FImage: ") (start-process "gimp" nil "gimp" (expand-file-name file))) (defun my-open-in-firefox (file) (interactive "FItem: ") (start-process "firefox" nil "firefox" (if (string-match "^http" file) file (expand-file-name file)))) (defvar my-image-autocrop-border 10) (defun my-image-autocrop (filename &optional border) (interactive "FFile: ") (setq border (or border my-image-autocrop-border)) (let ((args (append '("-trim") (if border `("-bordercolor" "#FFFFFF" "-border" ,(number-to-string border))) (list "+repage" filename)))) (apply #'call-process "mogrify" nil nil nil args))) (defun my-image-recognize (file) (interactive "FFile: ") (let ((data (json-parse-string (if (file-exists-p (concat (file-name-sans-extension file) ".json")) (with-temp-buffer (insert-file-contents (concat (file-name-sans-extension file) ".json")) (buffer-string)) (with-temp-file (concat (file-name-sans-extension file) ".json") (call-process "gcloud" nil t nil "ml" "vision" "detect-document" (expand-file-name file)) (buffer-string))) :object-type 'alist))) (if (assoc-default 'responses data) (assoc-default 'text (assoc-default 'fullTextAnnotation (elt (assoc-default 'responses data) 0))) (assoc-default 'description (elt (assoc-default 'textAnnotations data) 0))))) (defun my-image-recognize-get-new-filename (file) (interactive "FFile: ") (if-let* ((text (my-image-recognize file)) (id (and (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9]" text) (match-string 0 text))) (data (and id (my-journal-get-by-zidstring id)))) (concat id " " (plist-get data :Note) "." (file-name-extension file)))) (defun my-image-recognize-and-rename (file) (interactive "FFile: ") (let ((new-name (expand-file-name (my-image-recognize-get-new-filename file) (file-name-directory file)))) (rename-file file new-name t) new-name)) (defun my-image-store (file &optional do-move) "Copy or move this image into public or private sketches as needed." (unless (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9] " (file-name-nondirectory file)) (setq file (my-image-recognize-and-rename file))) (when (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]-[0-9][0-9] " (file-name-nondirectory file)) (funcall (if do-move 'rename-file 'copy-file) file (expand-file-name (file-name-nondirectory file) (if (string-match "#private" (file-name-nondirectory file)) my-private-sketches-directory (car my-sketch-directories))) t))) (defun my-image-copy-text (file) (interactive "FImage: ") (kill-new (my-image-recognize file))) (defun my-image-insert-text-as-details (file) (interactive "FImage: ") (when (and (derived-mode-p 'org-mode) (eq (org-element-type (org-element-context)) 'link)) (goto-char (org-element-end (org-element-context)))) (insert "\n#+begin_my_details\n" (my-image-recognize file) "\n#+end_my_details\n")) (with-eval-after-load 'embark (defvar-keymap my-embark-image-actions :doc "Images" "k" #'my-image-open-in-krita "a" #'my-image-open-in-annotator "i" #'my-image-open-in-inkscape "w" #'my-image-copy-text "c" #'my-image-autocrop "g" #'my-image-open-in-gimp "f" #'my-open-in-firefox "s" #'my-image-store "r" #'my-image-recognize-and-rename "t" #'my-org-sketch-open-text-file "C" #'my-image-recolor "d" #'my-image-insert-text-as-details) (add-to-list 'embark-keymap-alist '(image . my-embark-image-actions)))
Embark and subed
(defun my-subed-set-timestamp-to-mpv-position (&optional rest) (interactive) (skip-chars-backward "0-9:,.") (when (looking-at "\\(\\([0-9]+\\):\\)?\\([0-9]+\\):\\([0-9]+\\)\\.\\([0-9]+\\)") (replace-match (save-match-data (subed-msecs-to-timestamp subed-mpv-playback-position)) t t))) (defun my-embark-subed-timestamp () (save-excursion (skip-chars-backward "0-9:,.") (when (looking-at "\\(\\([0-9]+\\):\\)?\\([0-9]+\\):\\([0-9]+\\)\\.\\([0-9]+\\)") (list 'subed-timestamp (propertize (match-string 0) 'ms (compile-media-timestamp-to-msecs (match-string 0)) 'position (if (bolp) 'start 'stop)))))) (defun my-subed-adjust-timestamp (offset) (interactive (list -100)) (save-excursion (skip-chars-backward "0-9:,.") (when (looking-at subed-vtt--regexp-timestamp) (let ((new-ts (+ (subed-vtt--timestamp-to-msecs (match-string 0)) offset))) (replace-match (save-match-data (subed-vtt--msecs-to-timestamp new-ts))) (my-waveform-subed-show-after-time) new-ts)))) (defun my-subed-adjust-timestamp-up (offset) (interactive (list 100)) (subed-mpv-jump (my-subed-adjust-timestamp (- offset)))) (defun my-subed-adjust-timestamp-down (offset) (interactive (list -100)) (subed-mpv-jump (my-subed-adjust-timestamp (- offset)))) (defhydra my-subed-adjust-timestamp () ("<up>" my-subed-adjust-timestamp-up "Up" :exit nil) ("<down>" my-subed-adjust-timestamp-down "Down" :exit nil)) (defun my-subed-copy-timestamp-from-previous () (interactive) (let ((ms (save-excursion (subed-backward-subtitle-time-stop) (subed-subtitle-msecs-stop)))) (subed-set-subtitle-time-start ms))) (defun my-subed-copy-timestamp-to-next () (interactive) (let ((ms (subed-subtitle-msecs-stop))) (save-excursion (subed-forward-subtitle-time-stop) (subed-set-subtitle-time-start ms)))) (defun my-subed-copy-timestamp-dwim () (interactive) (save-excursion (skip-chars-backward "0-9:,.") (if (bolp) (my-subed-copy-timestamp-from-previous) (my-subed-copy-timestamp-to-next))))
Embark, symbols, and casual-symbol-overlay
Link: http://yummymelon.com/devnull/announcing-casual-symbol-overlay.html
(use-package casual-symbol-overlay :if my-laptop-p :after embark :init (with-eval-after-load 'embark (keymap-set embark-symbol-map "z" #'casual-symbol-overlay-tmenu)))
Extended command list
This code allows me to select a command from a short list of functions so that I can prompt my memory better. I wonder if this makes sense considering transient and hydra make keyboard shortcuts easier.
(my-execute-extended-command-from-list nil '(org-capture consult-buffer))
;;; Mostly the same as my/read-extended-command-from-list (defun my-read-extended-command-from-list (list) "Read command name to invoke in `execute-extended-command'." (minibuffer-with-setup-hook (lambda () (add-hook 'post-self-insert-hook (lambda () (setq execute-extended-command--last-typed (minibuffer-contents))) nil 'local) (setq-local minibuffer-default-add-function (lambda () ;; Get a command name at point in the original buffer ;; to propose it after M-n. (let ((def (with-current-buffer (window-buffer (minibuffer-selected-window)) (and (commandp (function-called-at-point)) (format "%S" (function-called-at-point))))) (all (sort (minibuffer-default-add-completions) #'string<))) (if def (cons def (delete def all)) all))))) ;; Read a string, completing from and restricting to the set of ;; all defined commands. Don't provide any initial input. ;; Save the command read on the extended-command history list. (completing-read (concat (cond ((eq current-prefix-arg '-) "- ") ((and (consp current-prefix-arg) (eq (car current-prefix-arg) 4)) "C-u ") ((and (consp current-prefix-arg) (integerp (car current-prefix-arg))) (format "%d " (car current-prefix-arg))) ((integerp current-prefix-arg) (format "%d " current-prefix-arg))) ;; This isn't strictly correct if `execute-extended-command' ;; is bound to anything else (e.g. [menu]). ;; It could use (key-description (this-single-command-keys)), ;; but actually a prompt other than "M-x" would be confusing, ;; because "M-x" is a well-known prompt to read a command ;; and it serves as a shorthand for "Extended command: ". "M-x ") (lambda (string pred action) (if (and suggest-key-bindings (eq action 'metadata)) '(metadata (affixation-function . read-extended-command--affixation) (category . command)) (complete-with-action action list string pred))) #'commandp t nil 'extended-command-history))) ;;; Mostly the same as execute-extended-command (defun my-execute-extended-command-from-list (prefixarg &optional command-name typed) ;; Based on Fexecute_extended_command in keyboard.c of Emacs. ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 "Read a command name, then read the arguments and call the command. To pass a prefix argument to the command you are invoking, give a prefix argument to `execute-extended-command'." (declare (interactive-only command-execute)) ;; FIXME: Remember the actual text typed by the user before completion, ;; so that we don't later on suggest the same shortening. (interactive (let ((execute-extended-command--last-typed nil)) (list current-prefix-arg (if (and command-name (listp command-name)) (my-read-extended-command-from-list command-name) (read-extended-command)) execute-extended-command--last-typed))) ;; Emacs<24 calling-convention was with a single `prefixarg' argument. (when (listp command-name) (let ((current-prefix-arg prefixarg) ; for prompt (execute-extended-command--last-typed nil)) (setq command-name (if command-name (my/read-extended-command-from-list command-name) (read-extended-command))) (setq typed execute-extended-command--last-typed))) (let* ((function (and (stringp command-name) (intern-soft command-name))) (binding (and suggest-key-bindings (not executing-kbd-macro) (where-is-internal function overriding-local-map t)))) (unless (commandp function) (error "`%s' is not a valid command name" command-name)) ;; Some features, such as novice.el, rely on this-command-keys ;; including M-x COMMAND-NAME RET. (set--this-command-keys (concat "\M-x" (symbol-name function) "\r")) (setq this-command function) ;; Normally `real-this-command' should never be changed, but here we really ;; want to pretend that M-x <cmd> RET is nothing more than a "key ;; binding" for <cmd>, so the command the user really wanted to run is ;; `function' and not `execute-extended-command'. The difference is ;; visible in cases such as M-x <cmd> RET and then C-x z (bug#11506). (setq real-this-command function) (let ((prefix-arg prefixarg)) (command-execute function 'record)) ;; If enabled, show which key runs this command. ;; But first wait, and skip the message if there is input. (let* ((waited ;; If this command displayed something in the echo area; ;; wait a few seconds, then display our suggestion message. ;; FIXME: Wait *after* running post-command-hook! ;; FIXME: If execute-extended-command--shorter were ;; faster, we could compute the result here first too. (when (and suggest-key-bindings (or binding (and extended-command-suggest-shorter typed))) (sit-for (cond ((zerop (length (current-message))) 0) ((numberp suggest-key-bindings) suggest-key-bindings) (t 2)))))) (when (and waited (not (consp unread-command-events))) (unless (or (not extended-command-suggest-shorter) binding executing-kbd-macro (not (symbolp function)) (<= (length (symbol-name function)) 2)) ;; There's no binding for CMD. Let's try and find the shortest ;; string to use in M-x. ;; FIXME: Can be slow. Cache it maybe? (while-no-input (setq binding (execute-extended-command--shorter (symbol-name function) typed)))) (when binding (with-temp-message (format-message "You can run the command `%s' with %s" function (if (stringp binding) (concat "M-x " binding " RET") (key-description binding))) (sit-for (if (numberp suggest-key-bindings) suggest-key-bindings 2))))))))
Repeatable commands
Based on http://oremacs.com/2015/01/14/repeatable-commands/ . Modified to
accept nil
as the first value if you don't want the keymap to run a
command by default, and to use kbd
for the keybinding definitions.
(defun my-def-rep-command (alist) "Return a lambda that calls the first function of ALIST. It sets the transient map to all functions of ALIST, allowing you to repeat those functions as needed." (let ((keymap (make-sparse-keymap)) (func (cdar alist))) (mapc (lambda (x) (when x (define-key keymap (kbd (car x)) (cdr x)))) alist) (lambda (arg) (interactive "p") (when func (funcall func arg)) (set-transient-map keymap t))))
Hydra keyboard shortcuts
hydra offers customizable shortcuts. transient is another option.
(use-package hydra :commands defhydra) (use-package use-package-hydra) (if my-laptop-p (use-package hydra-posframe :if my-laptop-p :after hydra :vc (:url "https://github.com/Ladicle/hydra-posframe") ))
(with-eval-after-load 'hydra (defhydra my-window-movement () ("<left>" windmove-left) ("<right>" windmove-right) ("<down>" windmove-down) ("<up>" windmove-up) ("y" other-window "other") ("h" switch-window "switch-window") ("b" consult-buffer "buffer") ("f" find-file "file") ("F" find-file-other-window "other file") ("v" (progn (split-window-right) (windmove-right))) ("o" delete-other-windows :color blue) ("a" ace-window) ("s" ace-swap-window) ("d" delete-window "delete") ("D" ace-delete-window "ace delete") ("i" ace-maximize-window "maximize") ("q" nil)))
(with-eval-after-load 'hydra (defhydra my-shortcuts (:exit t) ("j" my-helm-journal "Journal") ("C" my-resolve-orgzly-syncthing "Conflicts") ("n" my-capture-timestamped-note "Note") ("c" my-org-categorize-emacs-news/body "Categorize") ("d" my-emacs-news-check-duplicates "Dupe") ("s" save-buffer "Save") ("f" my-file-shortcuts/body "File shortcut") ("+" text-scale-increase "Increase") ("-" text-scale-decrease "Decrease") ("G" gif-screencast-start-or-stop "GIF screencast") ("g" my-geeqie/body "Geeqie") ("r" my-record-ffmpeg-toggle-recording "Record screen") ("l" (my-toggle-or-create "*scratch*" (lambda () (switch-to-buffer (startup--get-buffer-create-scratch)))) "Lisp") ("e" eshell-toggle "Eshell") ("w" my-engine-dmode-hydra/body "Search web") ("E" my-emacs-news/body "Emacs News")) (keymap-global-set "<f5>" #'my-shortcuts/body) (defhydra my-emacs-news (:exit t) "Emacs News" ("f" (find-file "~/sync/emacs-news/index.org") "News") ("C" (find-file "~/proj/emacs-calendar/README.org") "Calendar") ("C" (find-file "/ssh:web:/var/www/emacslife.com/calendar/README.org" "Calendar on server")) ("d" my-emacs-news-check-duplicates "Dupe") ("c" my-org-categorize-emacs-news/body "Categorize") ("h" (my-org-update-link-description "HN") "Link HN") ("i" (my-org-update-link-description "Irreal") "Link Irreal") ("m" my-share-emacs-news "Mail") ("t" (browse-url "https://tweetdeck.twitter.com") "Twitter"))) (defun my-org-update-link-description (description) "Update the current link's DESCRIPTION." (interactive "MDescription: ") (let (link) (save-excursion (cond ((org-in-regexp org-link-bracket-re 1) (setq link (org-link-unescape (match-string-no-properties 1))) (delete-region (match-beginning 0) (match-end 0)) (insert (org-link-make-string link description)) (sit-for 0)) ((or (org-in-regexp org-link-angle-re) (org-in-regexp org-link-plain-re)) (setq link (org-unbracket-string "<" ">" (match-string 0))) (delete-region (match-beginning 0) (match-end 0)) (insert (org-link-make-string link description)) (sit-for 0)))))) (defun my-org-insert-link () (interactive) (when (org-in-regexp org-link-bracket-re 1) (goto-char (match-end 0)) (insert "\n")) (call-interactively 'org-insert-link))
(defun my-switch-to-previous-buffer () "Switch to previously open buffer. Repeated invocations toggle between the two most recently open buffers." (interactive) (switch-to-buffer (other-buffer (current-buffer) 1))) (defun my-org-check-agenda () "Peek at agenda." (interactive) (cond ((derived-mode-p 'org-agenda-mode) (if (window-parent) (delete-window) (bury-buffer))) ((get-buffer "*Org Agenda*") (switch-to-buffer-other-window "*Org Agenda*")) (t (org-agenda nil "a"))))
From https://github.com/abo-abo/hydra/wiki/Nesting-Hydras :
(defvar hydra-stack nil) (defun my-hydra-push (expr) (push `(lambda () ,expr) hydra-stack)) (defun my-hydra-pop () (interactive) (let ((x (pop hydra-stack))) (when x (funcall x)))) (defun my-hydra-go-and-push (expr) (push hydra-curr-body-fn hydra-stack) (prin1 hydra-stack) (funcall expr)) ;; example (progn (hydra-b/body) (hydra-push '(hydra-a/body))) ;; or ("q" hydra-pop "exit")
Emacs Hydra: Allow completion when I can't remember the command name
2021-04-29: Added the ability to complete using an arbitrary Hydra.
So it turns out that I'm pretty much zonked after a day with the kiddo and have a hard time remembering keystrokes or speed-reading my Hydra cheat sheets. I want to be able to use M-x-like completion in my Hydra so that I can type a few characters and then maybe see the shortcuts there. Here's what it looks like:
(defun my-hydra-format-head (h) (let ((key-binding (elt h 0)) (hint (elt h 2)) (cmd (and (elt h 1) (prin1-to-string (elt h 1))))) (if cmd (format "%s (%s) - %s" hint key-binding cmd) (format "%s (%s)" hint key-binding)))) (defun my-hydra-heads-to-candidates (base) (mapcar (lambda (h) (cons (my-hydra-format-head h) (hydra--head-name h base))) (symbol-value (intern (concat (symbol-name base) "/heads"))))) (defun my-hydra-execute-extended (&optional _ hydra-base) (interactive (list current-prefix-arg nil)) (hydra-keyboard-quit) (let* ((candidates (my-hydra-heads-to-candidates (or hydra-base (intern (replace-regexp-in-string "/body$" "" (symbol-name hydra-curr-body-fn)))))) (command-name (completing-read "Cmd: " candidates)) (bind (assoc-default command-name candidates 'string=))) (cond ((null bind) nil) ((hydra--callablep bind) (call-interactively bind)))))
This is how I add it to all my hydras:
(with-eval-after-load 'hydra (define-key hydra-base-map (kbd "<tab>") #'my-hydra-execute-extended))
Proooobably works? Very rough. Might be useful for those fuzzy-brain days.
which-key and which-key-posframe
It's hard to remember keyboard shortcuts.
(use-package which-key :init (which-key-mode 1)) (use-package which-key-posframe :if my-laptop-p :init (which-key-posframe-mode 1))
Sometimes C-h
gets weird and calls which-key-C-h-dispatch
, probably from a transient map that got confused.
(defun my-reset-transients () (interactive) (setq overriding-terminal-local-map nil))
Key chords
I'm on a Dvorak keyboard, so these might not work
for you. Experimenting with this. key-chord
lets
you define keyboard shortcuts that use ordinary
keys typed in quick succession. I haven't been
using this lately, though…
Some code from http://emacsredux.com/blog/2013/04/28/switch-to-previous-buffer/
(defun my-key-chord-define (keymap keys command) "Define in KEYMAP, a key-chord of two keys in KEYS starting a COMMAND. \nKEYS can be a string or a vector of two elements. Currently only elements that corresponds to ascii codes in the range 32 to 126 can be used. \nCOMMAND can be an interactive function, a string, or nil. If COMMAND is nil, the key-chord is removed. MODIFICATION: Do not define the transposed key chord. " (if (/= 2 (length keys)) (error "Key-chord keys must have two elements")) ;; Exotic chars in a string are >255 but define-key wants 128..255 for those (let ((key1 (logand 255 (aref keys 0))) (key2 (logand 255 (aref keys 1)))) (define-key keymap (vector 'key-chord key1 key2) command))) (fset 'key-chord-define 'my-key-chord-define)
Now let's set up the actual keychords.
(use-package key-chord :if my-laptop-p :hydra (my-key-chord-commands () "Main" ("k" kill-sexp) ("h" my-org-jump :color blue) ("x" my-org-finish-previous-task-and-clock-in-new-one "Finish and clock in" :color blue) ("b" helm-buffers-list :color blue) ("f" find-file :color blue) ("a" my-org-check-agenda :color blue) ("c" (call-interactively 'org-capture) "capture" :color blue) ("t" (org-capture nil "T") "Capture task") ("." repeat) ("C-t" transpose-chars) ("o" my-org-off-my-computer :color blue) ("w" my-engine-mode-hydra/body "web" :exit t) ("m" imenu :color blue) ("i" my-capture-timestamped-note-with-screenshot :exit t) ("n" my-capture-timestamped-note "Timestamped note" :exit t) ("q" quantified-track :color blue) ("r" my-describe-random-interactive-function) ("l" org-insert-last-stored-link) ("L" my-org-insert-link)) :init (setq key-chord-one-key-delay 0.16) (setq key-chord-two-keys-delay 0.002) (key-chord-define-global "uu" 'undo) (key-chord-define-global "jr" 'my-goto-random-char-hydra/my-goto-random-char) (key-chord-define-global "kk" 'kill-whole-line) (key-chord-define-global "et" 'my-stream-message) (key-chord-define-global "em" 'embark-act) (key-chord-define-global ".t" 'my-stream/body) (key-chord-define-global "jj" 'avy-goto-word-1) (key-chord-define-global "yy" 'my-window-movement/body) (key-chord-define-global "jw" 'switch-window) (key-chord-define-global "jl" 'avy-goto-line) (key-chord-define-global "j." 'join-lines/body) (key-chord-define-global "FF" 'find-file) (key-chord-define-global "qq" 'my-quantified-hydra/body) (key-chord-define-global "hh" 'my-key-chord-commands/body) (key-chord-define-global "xx" 'er/expand-region) (key-chord-define-global " " 'my-insert-space-or-expand) (key-chord-define-global "vv" 'god-mode-all) (key-chord-define-global "JJ" 'my-switch-to-previous-buffer) (key-chord-mode -1)) ;; disable for now
Hmm, good point about C-t
being more useful as a Hydra than as transpose-char
. It turns out I actually do use C-t
a fair bit, but I can always add it back as an option.
(bind-key "C-t" 'my-key-chord-commands/body)
Completion
(use-package vertico :config (vertico-mode +1) (vertico-multiform-mode) (with-eval-after-load 'vertico-multiform (add-to-list 'vertico-multiform-categories '(embark-keybinding grid)))) (use-package orderless :custom (completion-styles '(orderless basic)) (completion-category-overrides '((file (styles basic partial-completion))))) (use-package prescient :config (prescient-persist-mode +1)) (use-package company-prescient :init (company-prescient-mode +1))
Consult
(use-package consult :load-path "~/vendor/consult" ;:quelpa (consult :fetcher github :repo "minad/consult") :after projectile :bind (("C-x r x" . consult-register) ("C-x r b" . consult-bookmark) ("C-c k" . consult-kmacro) ("C-x M-:" . consult-complex-command) ;; orig. repeat-complet-command ("C-x 4 b" . consult-buffer-other-window) ;; orig. switch-to-buffer-other-window ("C-x 5 b" . consult-buffer-other-frame) ("M-#" . consult-register-load) ("M-'" . consult-register-store) ;; orig. abbrev-prefix-mark (unrelated) ("C-M-#" . consult-register) ("M-g o" . consult-outline) ("M-g h" . consult-org-heading) ("M-g a" . consult-org-agenda) ("M-g m" . consult-mark) ("C-x b" . consult-buffer) ("M-g M-g" . consult-goto-line) ;; orig. goto-line ("M-g o" . consult-outline) ("M-g m" . consult-mark) ("M-g k" . consult-global-mark) ("M-g i" . consult-imenu) ("M-g I" . consult-project-imenu) ("M-g e" . consult-error) ;; M-s bindings (search-map) ("M-s f" . consult-find) ("M-s i" . consult-info) ("M-s L" . consult-locate) ("M-s g" . consult-grep) ("M-s G" . consult-git-grep) ("M-s r" . consult-ripgrep) ("M-s l" . consult-line) ("M-s m" . consult-multi-occur) ("M-s k" . consult-keep-lines) ("M-s u" . consult-focus-lines) ;; Isearch integration ("M-s e" . consult-isearch) ("M-g l" . consult-line) ("M-s m" . consult-multi-occur) ("C-x c o" . consult-multi-occur) ("C-x c SPC" . consult-mark) :map isearch-mode-map ("M-e" . consult-isearch) ;; orig. isearch-edit-string ("M-s e" . consult-isearch) ;; orig. isearch-edit-string ("M-s l" . consult-line)) :init (setq register-preview-delay 0 register-preview-function #'consult-register-format) :custom consult-preview-key '(:debounce 0.2 any) consult-narrow-key "<" :config (setq consult-project-root-function #'projectile-project-root))
Completing blog posts
(defalias 'my-complete-blog-post-url #'my-org-blog-complete) (defun my-blog-posts () (let ((json-object-type 'alist)) (json-read-file "~/proj/static-blog/_site/blog/all/index.json"))) (defun my-blog-edit-html (url) (interactive (list (my-org-blog-complete))) (let ((base (replace-regexp-in-string (concat "^" (regexp-quote my-blog-base-url)) "" url)) (filename (my-11ty-html-filename url))) (if filename (find-file filename) (error "Could not find file.")))) (defun my-blog-edit-json (url) (interactive (list (my-org-blog-complete))) (let* ((filename (my-11ty-html-filename url)) (json (and filename (concat (file-name-sans-extension filename) ".11tydata.json")))) (if json (find-file json) (error "Could not find file.")))) (defun my-view-blog-post-locally (url) (interactive (list (my-org-blog-complete))) (browse-url (replace-regexp-in-string (concat "^" (regexp-quote my-blog-base-url)) "https://localhost:8080/" url))) (defun my-insert-blog-post-url (url) (interactive (list (my-complete-blog-post-url))) (insert url)) (defun my-blog-title (url) (let ((base (replace-regexp-in-string (concat "^" (regexp-quote my-blog-base-url)) "/" url))) (alist-get 'title (seq-find (lambda (o) (string= (alist-get 'permalink o) base)) (my-blog-posts))))) (defun my-insert-blog-post-link (url) (interactive (list (my-complete-blog-post-url))) (if (derived-mode-p 'org-mode) (insert (org-link-make-string url (my-blog-title url))) (insert url)))
Completing sketches image
(declare-function 'my-geeqie-view "Sacha.el") (defun my-preview-image (candidate state) (when (and my-sketch-preview candidate) (my-geeqie-view (list candidate))) nil) (defun my-complete-sketch-filename () (interactive) (consult--read (my-sketches) :sort nil :state 'my-preview-image :prompt "Sketch: " :category 'sketch)) (defun my-date-from-filename (filename) (let ((f (file-name-nondirectory filename))) (if (string-match "^[-0-9]+" f) (replace-regexp-in-string "[^0-9]" "" (match-string 0 f)) nil))) (defvar my-sketches nil "Cache for sketch filenames.") (defun my-sketches () (interactive) (sort (apply 'append (mapcar (lambda (dir) (directory-files dir t "\\.\\(jpe?g\\|png\\|svg\\)$")) my-sketch-directories)) (lambda (a b) (string< (concat (or (my-date-from-filename b) "0") (file-name-nondirectory b)) (concat (or (my-date-from-filename a) "0") (file-name-nondirectory a)))))) (defvar my-sketch-preview nil "Non-nil means preview images.") (defun my-find-sketch (file) (interactive (list (my-complete-sketch-filename))) (find-file file)) (defun my-sketch-prepare-post (file) (interactive (list (my-complete-sketch-filename))) (insert (org-link-make-string (concat "sketchFull:" (file-name-base file)))) (let ((text (my-sketch-text file))) (when text (insert (format "\n\n#+begin_my_src \"Text from %s\"\n%s\n#"))))) (defun my-sketch-text (file) (cond ((file-exists-p (concat (file-name-sans-extension file) ".txt")) (with-temp-buffer (insert-file-contents (concat (file-name-sans-extension file) ".txt")) (buffer-string))) ((file-exists-p (concat (file-name-sans-extension file) ".json")) (let ((json-object-type 'alist)) (assoc-default 'description (elt (assoc-default 'textAnnotations (json-read-file (concat (file-name-sans-extension file) ".json"))) 0)))) (t (error "Can't find text.")))) (defun my-sketch-insert-text (file) (interactive "FFile: ") (let ((text (my-sketch-text file))) (insert (or text ""))))
Using projects as a source for consult-buffer
(use-package consult :after projectile :defines consult-buffer-sources :config (projectile-load-known-projects) (setq my-consult-source-projectile-projects `(:name "Projectile projects" :narrow ?P :category project :action ,#'projectile-switch-project-by-name :items ,projectile-known-projects)) (add-to-list 'consult-buffer-sources my-consult-source-projectile-projects 'append))
consult-omni
For some reason, installing consult-omni using the :vc
keyword was giving me problems, so I checked it out from Github instead.
I also needed to create a Google custom search JSON API key at https://developers.google.com/custom-search/v1/introduction .
(defun my-insert-or-replace-link (url &optional title) "Insert a link, wrap the current region in a link, or replace the current link." (cond ((derived-mode-p 'org-mode) (cond ((org-in-regexp org-link-bracket-re 1) (when (match-end 2) (setq title (match-string-no-properties 2))) (delete-region (match-beginning 0) (match-end 0))) ((org-in-regexp org-link-any-re 1) (delete-region (match-beginning 0) (match-end 0))) ((region-active-p) (setq title (buffer-substring-no-properties (region-beginning) (region-end))) (delete-region (region-beginning) (region-end)))) ;; update link (insert (org-link-make-string url title))) ((derived-mode-p 'org-mode) ; not in a link (insert (org-link-make-string url title))) ((and (region-active-p) (derived-mode-p 'markdown-mode)) (setq title (buffer-substring-no-properties (region-beginning) (region-end))) (delete-region (region-beginning) (region-end)) (insert (format "[%s](%s)" title url))) ((derived-mode-p 'markdown-mode) (insert (format "[%s](%s)" title url))) (t (insert (format "%s (%s)" title url))))) ;; override the embark actions (defun my-consult-omni-embark-copy-url-as-kill (cand) "Don't add spaces." (when-let ((s (and (stringp cand) (get-text-property 0 :url cand)))) (kill-new (string-trim s)))) (defun my-consult-omni-embark-insert-url (cand) "Don't add spaces." (when-let ((s (and (stringp cand) (get-text-property 0 :url cand)))) (insert (string-trim s)))) (defun my-consult-omni-embark-copy-title-as-kill (cand) "Don't add spaces." (when-let ((s (and (stringp cand) (get-text-property 0 :title cand)))) (kill-new (string-trim s)))) (defun my-consult-omni-embark-insert-title (cand) "Don't add spaces." (when-let ((s (and (stringp cand) (get-text-property 0 :title cand)))) (insert (string-trim s)))) (defun my-consult-omni-embark-insert-link (cand) "Don't add spaces." (let ((url (and (stringp cand) (get-text-property 0 :url cand ))) (title (and (stringp cand) (get-text-property 0 :title cand)))) (my-insert-or-replace-link url title))) (use-package consult-omni :load-path "~/vendor/consult-omni" :after (consult embark) :custom (consult-omni-show-preview t) ;;; show previews (consult-omni-preview-key "C-o") ;;; set the preview key to C-o :config (add-to-list 'load-path "~/vendor/consult-omni/sources") (require 'consult-omni-sources) (require 'consult-omni-embark) (setq consult-omni-sources-modules-to-load (list 'consult-omni-wikipedia 'consult-omni-google)) (consult-omni-sources-load-modules) (setq consult-omni-default-interactive-command #'consult-omni-google) :bind (("M-g w" . consult-omni) :map consult-omni-embark-general-actions-map ("i l" . #'my-consult-omni-embark-insert-link) ("i u" . #'my-consult-omni-embark-insert-url) ("i t" . #'my-consult-omni-embark-insert-title) ("w u" . #'my-consult-omni-embark-copy-url-as-kill) ("w t" . #'my-consult-omni-embark-copy-title-as-kill)))
STARTED Searching my blog, notes, and sketches with consult-ripgrep and consult-omni
(defun my-search-notes () (interactive) (consult-ripgrep '("~/sync/orgzly" "~/sync/static-blog/blog" "~/sync/sketches" "~/sync/topics"))) (defun my-search-public-notes () (interactive) (consult-ripgrep '("~/sync/static-blog/blog" "~/sync/sketches" "~/sync/topics")))
(cl-defun my-consult-omni--google-blog-fetch-results (input &rest args &key callback &allow-other-keys) "Fetches search results for INPUT from “Google Custom Search” service. Narrows to `my-blog-base-url'. Refer to URL `https://programmablesearchengine.google.com/about/' and URL `https://developers.google.com/custom-search/' for more info." (pcase-let* ((`(,query . ,opts) (consult-omni--split-command input (seq-difference args (list :callback callback)))) (opts (car-safe opts)) (count (plist-get opts :count)) (page (plist-get opts :page)) (filter (plist-get opts :filter)) (count (or (and count (integerp (read count)) (string-to-number count)) consult-omni-default-count)) (page (or (and page (integerp (read page)) (string-to-number page)) consult-omni-default-page)) (filter (or (and (integerp filter) filter) (and filter (string-to-number (format "%s" filter))) 1)) (filter (if (member filter '(0 1)) filter 1)) (count (min count 10)) (page (+ (* page count) 1)) (page (min page (- 100 count))) (params `(("q" . ,(format "site:%s+%s" (url-encode-url my-blog-base-url) (replace-regexp-in-string " " "+" query))) ("key" . ,(consult-omni-expand-variable-function consult-omni-google-customsearch-key)) ("cx" . ,(consult-omni-expand-variable-function consult-omni-google-customsearch-cx)) ("gl" . "en") ("filter" . ,(format "%s" filter)) ("num" . ,(format "%s" count)) ("start" . ,(format "%s" page)))) (headers '(("Accept" . "application/json") ("Accept-Encoding" . "gzip") ("User-Agent" . "consult-omni (gzip)")))) (consult-omni--fetch-url consult-omni-google-customsearch-api-url consult-omni-http-retrieve-backend :encoding 'utf-8 :params params :headers headers :parser #'consult-omni--json-parse-buffer :callback (lambda (attrs) (let* ((raw-results (gethash "items" attrs)) (annotated-results (mapcar (lambda (item) (let* ((source "Google") (url (format "%s" (gethash "link" item))) (title (format "%s" (gethash "title" item))) (snippet (string-trim (format "%s" (gethash "snippet" item)))) (search-url (consult-omni--make-url-string consult-omni-google-search-url params '("key" "cx" "gl"))) (decorated (funcall consult-omni-default-format-candidate :source source :query query :url url :search-url search-url :title title :snippet snippet))) (propertize decorated :source source :title title :url url :search-url search-url :query query :snippet snippet))) raw-results))) (when (and annotated-results (functionp callback)) (funcall callback annotated-results)) annotated-results))))) (use-package consult-omni :load-path "~/vendor/consult-omni" :after (consult embark) :config (consult-omni-define-source "Google my blog" :narrow-char ?b :type 'dynamic :require-match nil :face 'consult-omni-engine-title-face :request #'my-consult-omni--google-blog-fetch-results :on-new (apply-partially #'consult-omni-external-search-with-engine "Google") :preview-key consult-omni-preview-key :search-hist 'consult-omni--search-history :select-hist 'consult-omni--selection-history :enabled (lambda () (bound-and-true-p consult-omni-google-customsearch-key)) :group #'consult-omni--group-function :sort t :interactive consult-omni-intereactive-commands-type :annotate nil))
To get more results, I can add parameters like -- --count 10
and --page 2
. I wonder if there's an easier keyboard shortcut for paginating through results…
Let's try these shortcuts…
(keymap-global-set "M-g b" #'my-search-public-notes) (keymap-global-set "M-g N" #'my-search-notes) (keymap-global-set "M-g B" #'consult-omni-google-my-blog)
Marginalia
Marginalia - add function name for aliases
(use-package marginalia :quelpa (marginalia :fetcher github :repo "minad/marginalia") :init (marginalia-mode) :bind (:map minibuffer-local-completion-map ("M-m" . marginalia-cycle)) :config (add-to-list 'marginalia-prompt-categories '("sketch" . sketch)) (add-to-list 'marginalia-censor-variables "-api-key") (cl-pushnew #'marginalia-annotate-symbol-with-alias (alist-get 'command marginalia-annotator-registry)) (cl-pushnew #'marginalia-annotate-symbol-with-alias (alist-get 'function marginalia-annotator-registry)) (cl-pushnew #'marginalia-annotate-symbol-with-alias (alist-get 'symbol marginalia-annotator-registry))) (defun marginalia-annotate-alias (cand) "Annotate CAND with the function it aliases." (when-let ((sym (intern-soft cand)) (alias (car (last (function-alias-p sym)))) (name (and (symbolp alias) (symbol-name alias)))) (format " (%s)" name))) (defun marginalia-annotate-symbol-with-alias (cand) "Annotate symbol CAND with its documentation string. Similar to `marginalia-annotate-symbol'." (when-let (sym (intern-soft cand)) (concat (marginalia-annotate-binding cand) (marginalia--fields ((marginalia-annotate-alias cand) :face 'marginalia-function) ((marginalia--symbol-class sym) :face 'marginalia-type) ((cond ((fboundp sym) (marginalia--function-doc sym)) ((facep sym) (documentation-property sym 'face-documentation)) (t (documentation-property sym 'variable-documentation))) :truncate 1.0 :face 'marginalia-documentation)))))
Marginalia and annotating journal entries
The following code annotates journal entries with their categories.
(defun my-marginalia-annotate-journal (cand) (when-let ((o (cdr (assoc cand my-journal-search-cache)))) (marginalia--fields ((plist-get o :Category) :face 'marginalia-documentation :truncate 13)))) (use-package marginalia :config (add-to-list 'marginalia-annotator-registry '(journal my-marginalia-annotate-journal builtin none)))
Cargo-culted stuff
(defun my-store-action-key+cmd (cmd) (setq keycast--this-command-keys (this-single-command-keys) keycast--this-command cmd)) (defun my-force-keycast-update (&rest _) (force-mode-line-update t)) (use-package keycast :if my-laptop-p :after embark :config (dolist (cmd '(embark-act embark-act-noexit embark-become)) (advice-add cmd :before #'my-force-keycast-update))) (use-package embark :config ;(setq embark-prompter 'embark-completing-read-prompter) (advice-add 'embark-keymap-prompter :filter-return #'my-store-action-key+cmd) (add-to-list 'embark-target-injection-hooks '(my-stream-message embark--allow-edit)))
Appearance
color-theme sometimes comes across lists. Odd!
(defadvice face-attribute (around sacha activate) (if (symbolp (ad-get-arg 0)) ad-do-it))
Display
(defun sanityinc/adjust-opacity (frame incr) (let* ((oldalpha (or (frame-parameter frame 'alpha) 100)) (newalpha (+ incr oldalpha))) (when (and (<= frame-alpha-lower-limit newalpha) (>= 100 newalpha)) (modify-frame-parameters frame (list (cons 'alpha newalpha)))))) (keymap-global-set "C-M-8" (lambda () (interactive) (sanityinc/adjust-opacity nil -2))) (keymap-global-set "C-M-9" (lambda () (interactive) (sanityinc/adjust-opacity nil 2))) (keymap-global-set "C-M-0" (lambda () (interactive) (modify-frame-parameters nil `((alpha . 100)))))
From https://protesilaos.com/codelog/2024-11-28-basic-emacs-configuration/:
(add-to-list 'display-buffer-alist '("\\`\\*\\(Warnings\\|Compile-Log\\)\\*\\'" (display-buffer-no-window) (allow-no-window . t)))
Color theme
Set up a light-on-dark color scheme
(defun my-setup-color-theme () (interactive) (when (display-graphic-p) (load-theme (car modus-themes-to-toggle)))) (use-package modus-themes :quelpa (modus-themes :fetcher github :repo "protesilaos/modus-themes") :init (setq modus-themes-to-toggle '(modus-vivendi-tinted modus-operandi-tinted)) :config (my-setup-color-theme))
I sometimes need to switch to a lighter background for screenshots.
For that, I use modus-operandi-tinted
.
Making highlight-sexp follow modus-themes-toggle elisp emacs
modus-themes-get-color-value function. Yay! Also, it turns out that I need to update the overlay in all the buffers.
Prot just added a
I'm experimenting with using the highlight-sexp
minor mode to
highlight my current s-expression, since I sometimes get confused
about what I'm modifying with smartparens. The highlight-sexp
background colour is hardcoded in the variable
hl-sexp-background-color
, and will probably look terrible if you use
a light background. I wanted it to adapt when I use
modus-themes-toggle
. Here's how that works:
(use-package highlight-sexp :quelpa (highlight-sexp :repo "daimrod/highlight-sexp" :fetcher github :version original) :after modus-themes :hook ((emacs-lisp-mode . highlight-sexp-mode) (modus-themes-after-load-theme . my-hl-sexp-update-all-overlays)) :config (defun my-hl-sexp-update-overlay () (when (overlayp hl-sexp-overlay) (overlay-put hl-sexp-overlay 'face `(:background ,(modus-themes-get-color-value 'bg-inactive))))) (defun my-hl-sexp-update-all-overlays (&rest args) (dolist (buf (buffer-list)) (with-current-buffer buf (when highlight-sexp-mode (my-hl-sexp-update-overlay))))) (advice-add 'hl-sexp-create-overlay :after 'my-hl-sexp-update-overlay))
This is what it looks like:
Modeline
Time in the modeline
I like having the clock.
(display-time-mode 1)
Diminish mode names in modeline
(use-package diminish :ensure t)
Highlight the active modeline using colours from modus-themes emacs
I wanted to experiment with for colouring the mode line of the active window ever so slightly different to make it easier to see where the active window is. I usually have global-hl-line-mode
turned on, so that highlight is another indicator, but let's see how this tweak feels. I modified the code so that it uses the theme colours from the currently-selected Modus themes, since I trust Prot's colour choices more than I trust mine. Thanks to Irreal for sharing Ignacio's comment!
(defun my-update-active-mode-line-colors () (set-face-attribute 'mode-line nil :foreground (modus-themes-get-color-value 'fg-mode-line-active) :background (modus-themes-get-color-value 'bg-blue-subtle))) (use-package modus-themes :hook (modus-themes-after-load-theme . my-update-active-mode-line-colors))
Quickly adding face properties to regions emacs
- : Set the first frame of the animated GIF to a reasonable backup image.
:init-value nil
to the mode.
: Add
Sometimes I just want to make some text look a
little fancier in the buffer so that I can make a
thumbnail or display a message. This
my-add-face-text-property
function lets me
select a region and temporarily change its height,
make it bold, or do other things. It will work in
text-mode
or enriched-mode
buffers (not Org
Mode or programming buffers like *scratch*
, as
those do a lot of font-locking).
(defun my-add-face-text-property (start end attribute value) (interactive (let ((attribute (intern (completing-read "Attribute: " (mapcar (lambda (o) (symbol-name (car o))) face-attribute-name-alist))))) (list (point) (mark) attribute (read-face-attribute '(()) attribute)))) (add-face-text-property start end (list attribute value)))
enriched-mode
has some keyboard shortcuts for
face attributes (M-o b
for bold, M-o i
for
italic). I can add some keyboard shortcuts for
other properties even if they can't be saved in
text/enriched
format.
(defun my-face-text-larger (start end) (interactive "r") (add-face-text-property start end (list :height (floor (+ 50 (car (alist-get :height (get-text-property start 'face) '(100)))))))) (defun my-face-text-smaller (start end) (interactive "r") (add-face-text-property start end (list :height (floor (- (car (alist-get :height (get-text-property start 'face) '(100))) 50)))))
What's an easy way to make this keyboard shortcut
available during the rare times I want it? I know,
maybe I'll make a quick minor mode so I don't
have to dedicate those keyboard shortcuts all the
time. repeat-mode
lets me change the size by
repeating just the last keystroke.
(defvar-keymap my-face-text-property-mode-map "M-o p" #'my-add-face-text-property "M-o +" #'my-face-text-larger "M-o -" #'my-face-text-smaller) (define-minor-mode my-face-text-property-mode "Make it easy to modify face properties." :init-value nil (repeat-mode 1)) (defvar-keymap my-face-text-property-mode-repeat-map :repeat t "+" #'my-face-text-larger "-" #'my-face-text-smaller) (dolist (cmd '(my-face-text-larger my-face-text-smaller)) (put cmd 'repeat-map 'my-face-text-property-mode-repeat-map))
Icons
https://protesilaos.com/codelog/2024-11-28-basic-emacs-configuration/
(use-package nerd-icons :ensure t) (use-package nerd-icons-completion :ensure t :after marginalia :config (add-hook 'marginalia-mode-hook #'nerd-icons-completion-marginalia-setup)) (use-package nerd-icons-corfu :ensure t :after corfu :config (add-to-list 'corfu-margin-formatters #'nerd-icons-corfu-formatter)) (use-package nerd-icons-dired :ensure t :hook (dired-mode . nerd-icons-dired-mode))
Reading
https://github.com/xahlee/xah_emacs_init/blob/master/xah_emacs_font.el From Xah Lee:
(defun xah-toggle-margin-right () "Toggle the right margin between `fill-column' or window width. This command is convenient when reading novel, documentation." (interactive) (if (eq (cdr (window-margins)) nil) (set-window-margins nil 0 (- (window-body-width) fill-column)) (set-window-margins nil 0 0)))
(use-package pdf-tools :if my-laptop-p :config (pdf-tools-install) (setq pdf-view-resize-factor 1.1) (setq-default pdf-view-display-size 'fit-page) )
Writing and editing
(keymap-global-set "M-c" #'capitalize-dwim) (setq-default fill-column 50)
gif-screencast
Animated GIFs make it easy to demonstrate things,
and gif-screencast makes it easy to record a
screencast with each command getting its own GIF
frame. In my config, I have s-s
(super-s, or the
Windows key + s) bound to
gif-screencast-start-or-stop
. I like adding
animated GIFs to my blog posts and videos.
Not all interfaces can display animated GIFs. For example, some people read my blog in elfeed or in a console Emacs and can see only the first frame of a GIF. It makes sense to select the a frame to use as the fallback for the animated GIF, much like videos can have thumbnails.
When I stop gif-screencast, I want to pick a frame and use it as the first frame. Let's see if this works…
(defun my-gif-screencast-start-or-stop-and-choose-thumbnail () "Start a screencast or pause recording." (interactive) (if gif-screencast-mode (progn (gif-screencast-toggle-pause) (dired gif-screencast-screenshot-directory) (revert-buffer) (dired gif-screencast-screenshot-directory) (image-dired gif-screencast-screenshot-directory)) (gif-screencast)))
Actually, what I want to do is a more general case: be able to delete frames, copy frames to the beginning, eventually move frames around, etc., and then generate the GIF based on the contents of that directory.
(defun my-gif-screencast-copy-image-to-first-frame (file) (interactive (list (dired-get-filename))) ;; Determine the timestamp of the first file in this directory (copy-file file (expand-file-name (format-time-string "screen-%F-%T-%3N.png" (time-subtract (my-gif-screencast-timestamp-from-filename (car (directory-files gif-screencast-screenshot-directory nil ".png"))) (seconds-to-time 0.001))) gif-screencast-screenshot-directory))) (defun my-gif-screencast-timestamp-from-filename (file) (setq file (replace-regexp-in-string "^screen-" "" (file-name-base file))) (time-add (date-to-time (format "%s %s" (substring file 0 10) (substring file 11 19))) (float-time (/ (string-to-number (substring file 20 23)) 1000.0)))) (cl-assert (string= (format-time-string "test-%F-%T-%3N" (my-gif-screencast-timestamp-from-filename "screen-2024-09-20-13:18:08-024.png")) "test-2024-09-20-13:18:08-024")) (defun my-gif-screencast-update-frames-from-directory () (interactive) (let* ((files (directory-files gif-screencast-screenshot-directory nil ".png")) (start-time (my-gif-screencast-timestamp-from-filename (car files)))) (setq gif-screencast--frames (mapcar (lambda (o) (make-gif-screencast-frame :timestamp (my-gif-screencast-timestamp-from-filename o) :filename o)) files)) (gif-screencast-mode 0) (gif-screencast--finish)))
Someday it could be pretty cool to have an SVG where I can see the frames on a timeline and then drag them around. In the meantime, let's see how this works out.
(use-package gif-screencast :bind ("s-s" . my-gif-screencast-start-or-stop-and-choose-thumbnail) :config (setq gif-screencast-output-directory my-recordings-dir)) (use-package giffy :quelpa (giffy :fetcher github :repo "larsmagne/giffy"))
Sentences end with a single space
In my world, sentences end with a single space. This makes sentence navigation commands work for me.
(setq sentence-end-double-space nil)
Writeroom
(use-package writeroom-mode :config (setq writeroom-global-effects (remove 'writeroom-set-fullscreen writeroom-global-effects)))
Try redacting emacs config
(defun my-redact (s) "Replace S with x characters." (make-string (length s) ?x)) (defun my-redact-region (beg end &optional func) "Redact from BEG to END." (interactive "r") (let ((overlay (make-overlay beg end))) (overlay-put overlay 'redact t) (overlay-put overlay 'display (cond ((functionp func) (funcall func)) ((stringp func) func) (t (make-string (- end beg) ?x)))))) (defun my-redact-regexp-replacement (regexp replacement &optional beg end) "Redact buffer content matching regexp." (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last) (read-string "Replacement (ex: \\1 \\,(my-redact \\2)): "))) (setq beg (or beg (point-min))) (setq end (or end (point-max))) (when (stringp replacement) (setq replacement (query-replace-compile-replacement replacement t))) (save-excursion (goto-char beg) (while (re-search-forward regexp end t) (my-redact-region (match-beginning 0) (match-end 0) (with-temp-buffer (insert (match-string 0)) (goto-char (point-min)) ) (replace-regexp-in-string regexp replacement (match-string 0)))))) (defun my-redact-regexp (regexp &optional beg end func) "Redact buffer content matching regexp." (interactive (list (string-trim (read-regexp "Redact regexp: " 'regexp-history-last)))) (save-excursion (goto-char (or beg (point-min))) (while (re-search-forward regexp (or end (point-max)) t) (my-redact-region (match-beginning 0) (match-end 0) func)))) (defun my-unredact () (interactive) (mapc 'delete-overlay (seq-filter (lambda (overlay) (overlay-get overlay 'redact)) (overlays-in (point-min) (point-max))))) (defun my-redact-email-string (s) (replace-regexp-in-string "\\([-+_~a-zA-Z0-9][-+_.~:a-zA-Z0-9]*\\)@\\([-a-zA-Z0-9]+[-.a-zA-Z0-9]*\\)" (lambda (sub) (concat (make-string (length (match-string 1 sub)) ?x) "@" (make-string (length (match-string 2 sub)) ?x))) s)) (defun my-redact-emails (&rest _) (interactive) (my-redact-regexp "\\([-+_~a-zA-Z0-9][-+_.~:a-zA-Z0-9]*\\)@\\([-a-zA-Z0-9]+[-.a-zA-Z0-9]*\\)" nil nil (lambda () (my-redact-email-string (match-string 0))))) (defun my-redact-emacsconf-org () (interactive) (my-redact-regexp-replacement "\\(^:EMAIL:[ \t]+\\)\\(.+\\)" "\\1 \\,(my-redact \\2)" )) (defun my-redact-tabulated-list-in-rectangle (regexp beg end) ;; tabulated columns use substrings with display properties ;; so we should skip any characters that have text-property-any 'display (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last) (min (point) (mark)) (max (point) (mark)))) (apply-on-rectangle (lambda (start-col end-col) (let ((start-pos (and (move-to-column start-col) (point))) (end-pos (and (move-to-column end-col) (point))) display-prop) (save-restriction (narrow-to-region start-pos end-pos) (goto-char start-pos) (setq display-prop (text-property-search-forward 'display)) (if display-prop (while display-prop (my-redact-regexp regexp start-pos (prop-match-beginning display-prop)) (setq start-pos (prop-match-end display-prop)) (setq display-prop (text-property-search-forward 'display))) (my-redact-regexp regexp start-pos end-pos))))) beg end)) (defun my-redact-regexp-in-rectangle (regexp beg end) (interactive (list (read-regexp "Redact regexp: " 'regexp-history-last) (min (point) (mark)) (max (point) (mark)))) (apply-on-rectangle (lambda (start-col end-col) (my-redact-regexp regexp (and (move-to-column start-col) (point)) (and (move-to-column end-col) (point)))) beg end)) (advice-add #'notmuch-show :after #'my-redact-emails)
DONE Audio braindump workflow tweaks: Adding Org Mode hyperlinks to recordings based on keywords audio writing
Added a quick video!
Summary sketch
Audio recording is handy for capturing thoughts as I wait, walk around, or do chores. But my wireless earbuds don't have a good mic, I rarely got back to reviewing the wall of text, and I don't trust speech recognition to catch all my words.
Here's a new brain-dumping workflow that I've been experimenting with, though. I use a lapel mic to record in my phone. Google Recorder gives me an audio file as well as a rough transcript right away.
Animated GIF showing Google Recorder 's real-time transcript
I copy those with Syncthing.
If I use keywords like "start" or "stop" along with things like "topic", "reminder", or "summary", then I can put those on separate lines automatically (my-audio-braindump-prepare-alignment-breaks
).
... News. Miscellaneous little tasks that he doing. I do want to finish that blog post about the playlist Just so that it's out. Something else that people can, you know, refer to or that I can refer to. Uh, And at some point I want to think about, This second brain stuff. So, right now, What's my current state? Uh, START CHAPTER second brain STOP CHAPTER Right now, I dumped everything into originally. In my inbox, if I come across an interesting website. As usually in my phone. So then I share it. As. Something links at those or four none. Uh, into my inbox. ...
I use subed-align
to get the timestamps, and add the headings.
00:20:18.680 --> 00:20:24.679 So, right now, What's my current state? Uh, NOTE CHAPTER: second brain 00:20:24.680 --> 00:20:30.719 START CHAPTER second brain STOP CHAPTER
I can then create an Org Mode TODO item with a quick hyperlinked summary as well as my transcript.
I can jump to the audio if there are misrecognized words.
Screenshot of jumping to the audio
I can use subed-waveform to tweak the start and end times. (subed-waveform-show-current
, then left-clicking to set the start or right-clicking to set the end, or using keybindings to adjust the start/stop).
Someday I'll write code to send sections to a better speech recognition engine or to AI. In the meantime, this is pretty good.
Here's how the code works:
Recognizing keyword phrases
There are several things I want to do while dictating.
- I want to mark different topics so that it's easy to find the section where I was talking about something.
- I might want to set tags or priorities, or even schedule something (today, tomorrow, next week, next month).
- I can also use commands to trigger different things, like sending the section to a better speech recognition engine.
By analyzing the text, I might be able to make my own command system.
So far, for starting keywords, I can use "start", "begin", or "open". I pair that with one of these part keywords:
- "section", "chapter", "topic", "summary": I use these pretty interchangeably at the moment. I want them to make a new Org heading.
- "next steps": could be handy for being able to quickly see what to do next
- "reminder":
- "interruption": don't know what I'll use this for yet, but it might be useful to note this.
- "tag", "keyword": maybe use this to add tags to the current section?
Then the code can extract the text until the matching "stop/close/end
<part>", assuming it happens within 50 words or so.
(my-audio-braindump-close-keyword-distance-words
)
Sometimes keywords get misrecognized. "Begin summary" sometimes becomes "again summary" or "the game summary". I could try "open" and "close". Commercial dictation programs like Dragon NaturallySpeaking use "open" and "close" for punctuation, so that would probably work fine. "Start" works well, but "end" doesn't because it can confused with "and".
Sometimes an extra word sneaks in, either because I say it or because
the speech recognition tries too hard to guess. "Begin reminder" ends
up as "Begin a reminder." I changed from using regular expressions
that searched for just start-keyword + part-keyword to one that looked
for the start of the keyword phrase and then looked for the next
keyword within the next X words. (my-audio-braindump-scan-for-part-keyword
)
Recognizing phrases
(defvar my-audio-braindump-open-keywords '("start" "begin" "open")) (defvar my-audio-braindump-close-keywords '("stop" "end" "close")) (defvar my-audio-braindump-part-keywords '("summary" "chapter" "topic" "section" "action" "idea" "journal" "reminder" "command" "interruption" "note" "next step" "next steps" "tags" "tag" "keywords" "keyword")) (defvar my-audio-braindump-part-keyword-distance-words 2 "Number of words to scan for part keyword.") (defvar my-audio-braindump-close-keyword-distance-words 50 "number of words to scan for stop keyword. Put the keywords on the same line if found.") (defun my-audio-braindump-scan-for-part-keyword (before-part &optional part-keywords within-distance before-distance) "Look for BEFORE-PART followed by PART-KEYWORDS. There might be WITHIN-DISTANCE words between BEFORE-PART and PART-KEYWORDS, and the pair might be within BEFORE-DISTANCE from point. Distances are in words. Return (start end before-part part) if found, nil otherwise." (setq before-part (pcase before-part ('start my-audio-braindump-open-keywords) ('stop my-audio-braindump-close-keywords) ('nil (append my-audio-braindump-open-keywords my-audio-braindump-close-keywords)) (_ before-part))) (if (stringp before-part) (setq before-part (list before-part))) (setq part-keywords (or part-keywords my-audio-braindump-part-keywords)) (when (stringp part-keywords) (setq part-keywords (list part-keywords))) (setq within-distance (or within-distance my-audio-braindump-part-keyword-distance-words)) (setq before-distance (if (eq before-distance t) (point-max) (or before-distance my-audio-braindump-close-keyword-distance-words))) (let (result start end (before-point (save-excursion (forward-word before-distance) (point))) before-word part-word) (save-excursion (when (looking-at (regexp-opt before-part)) (setq before-word (match-string 0) start (match-beginning 0)) (when (re-search-forward (regexp-opt part-keywords) (save-excursion (forward-word within-distance) (point)) t) (setq result (list start (match-end 0) before-word (match-string 0))))) (while (and (not result) (re-search-forward (regexp-opt before-part) before-point t)) (setq before-word (match-string 0) start (match-beginning 0)) (when (re-search-forward (regexp-opt part-keywords) (save-excursion (forward-word within-distance) (point)) t) (setq result (list start (match-end 0) before-word (match-string 0))))) (when result (goto-char (elt result 1))) result))) (ert-deftest my-audio-braindump-scan-for-part-keyword () (with-temp-buffer (insert "some text start a reminder hello world stop there and do something stop reminder more text") (goto-char (point-min)) (let ((result (my-audio-braindump-scan-for-part-keyword 'start nil))) (expect (elt result 2) :to-equal "start") (expect (elt result 3) :to-equal "reminder")) (let ((result (my-audio-braindump-scan-for-part-keyword 'stop "reminder"))) (expect (elt result 2) :to-equal "stop") (expect (elt result 3) :to-equal "reminder"))))
Splitting the lines based on keywords and oopses
Now I can use that to scan through the text. I want to put commands on
their own lines so that subed-align
will get the timestamp for that
segment and so that the commands are easier to parse.
I also want to detect "oops" and split things up so that the start of
that line matches my correction after the "oops". I use
my-subed-split-oops for that, which I should write about in another
post. By putting the oops fragment on its own line, I can use
subed-align
to get a timestamp for just that segment. Then I can
either use flush-lines
to get rid of anything with "oops" in it. I
can even remove the subtitle and use subed-record-compile-media
to
compile audio/video without that segment, if I want to use the audio
without rerecording it.
And the way I can help is by jotting words down in a mind map, typing her sentences. Oops typing, her sentences And generating, follow-up questions.
I also all-caps the keyword phrases so that they're easier to see when skimming the text file.
Alignment breaks
(defun my-audio-braindump-prepare-alignment-breaks () "Split lines in preparation for forced alignment with aeneas. Split \"oops\" so that it's at the end of the line and the previous line starts with roughly the same words as the next line, for easier removal. Add a linebreak before \"begin/start\" followed by `my-audio-braindump-part-keywords'. Add a linebreak after \"stop\" followed by `my-audio-braindump-part-keywords'. Look for begin keyword ... stop keyword with at most `my-audio-braindump-part-keyword-distance-words' between them and put them on one line. If begin or stop has been misrecognized, try the best guess." (interactive) (let ((case-fold-search t) result close-result) (my-split-oops) ;; break "begin/start keyword" (goto-char (point-min)) (while (setq result (my-audio-braindump-scan-for-part-keyword 'start nil nil t)) (goto-char (car result)) (delete-region (car result) (elt result 1)) (insert "\n" (upcase (concat (elt result 2) " " (elt result 3))) "\n")) ;; break stop (goto-char (point-min)) (while (setq result (my-audio-braindump-scan-for-part-keyword 'stop nil nil t)) (goto-char (car result)) (delete-region (car result) (elt result 1)) (insert (upcase (concat (elt result 2) " " (elt result 3))) "\n")) ;; try to get start and end sections on one line (goto-char (point-min)) (while (setq result (my-audio-braindump-scan-for-part-keyword 'start nil nil t)) (goto-char (elt result 1)) (setq stop-result (my-audio-braindump-scan-for-part-keyword 'stop (elt result 3))) (if stop-result (progn (goto-char (car stop-result)) (while (re-search-backward " *\n+ *" (car result) t) (replace-match " "))) ;; no stop keyword; is the keyword around? maybe it was just misrecognized (if (re-search-forward (elt result 3) (save-excursion (forward-word my-audio-braindump-close-keyword-distance-words) (point)) t) (save-excursion (goto-char (match-beginning 0)) (save-excursion (insert " STOP ")) (while (re-search-backward " *\n+ *" (car result) t) (replace-match " "))) (when (looking-at "\n+ *") (replace-match " "))))) ;; Check for stops without starts (goto-char (point-min)) (while (setq result (my-audio-braindump-scan-for-part-keyword 'stop nil nil t)) (goto-char (car result)) (save-excursion (unless (re-search-backward (elt result 3) (line-beginning-position) t) (when (re-search-backward (elt result 3) (save-excursion (backward-word my-audio-braindump-close-keyword-distance-words) (point)) t) (replace-match (concat "\nSTART " (elt result 3)))))) (goto-char (cadr result))) ;; remove empty lines (goto-char (point-min)) (when (looking-at "\n+") (replace-match "")) (while (re-search-forward "\n\n+" nil t) (replace-match "\n")) (goto-char (point-min)) (while (re-search-forward " *\n *" nil t) (replace-match "\n")))) (ert-deftest my-audio-braindump-prepare-alignment-breaks () (with-temp-buffer (insert "some text start a reminder hello world stop there and do something stop reminder more text") (goto-char (point-min)) (my-audio-braindump-prepare-alignment-breaks) (expect (buffer-string) :to-equal "some text START REMINDER hello world stop there and do something STOP REMINDER more text")))
Preparing the VTT subtitles
subed-align
gives me a VTT subtitle file with timestamps and text. I
add NOTE comments with the keywords and make subed:
links to the
timestamps using the ol-subed.el
that I just added.
Putting keyword phrases in comments
(defun my-audio-braindump-get-subtitle-note-based-on-keywords (sub-text) (let ((case-fold-search t)) (when (string-match (concat "^" (regexp-opt my-audio-braindump-open-keywords) " \\(" (regexp-opt my-audio-braindump-part-keywords) "\\) \\(.+?\\)\\( " (regexp-opt my-audio-braindump-close-keywords) " " (regexp-opt my-audio-braindump-part-keywords) "\\)?$") sub-text) (concat (match-string 1 sub-text) ": " (match-string 2 sub-text))))) (ert-deftest my-audio-braindump-get-subtitle-note-based-on-keywords () (expect (my-audio-braindump-get-subtitle-note-based-on-keywords "BEGIN NEXT STEPS . Think about how dictation helps me practice slower speed. CLOSE NEXT STEPS") :to-equal "NEXT STEPS: . Think about how dictation helps me practice slower speed.") (expect (my-audio-braindump-get-subtitle-note-based-on-keywords "START SUMMARY hello world STOP SUMMARY") :to-equal "SUMMARY: hello world") (expect (my-audio-braindump-get-subtitle-note-based-on-keywords "START CHAPTER hello world again") :to-equal "CHAPTER: hello world again") )
Formatting the subtitles into Org Mode subtrees
The last step is to take the list of subtitles and format it into the subtree.
Formatting the subtree
;; todo: sort the completion? https://emacs.stackexchange.com/questions/55502/list-files-in-directory-in-reverse-order-of-date ;; (defun my-audio-braindump-insert-subtitles-as-org-tree (vtt-filename) (interactive (list (read-file-name "VTT: " (expand-file-name "./" my-phone-recording-dir) nil t nil (lambda (s) (string-match "\\.vtt$" s))))) (let* ((subtitles (mapcar (lambda (sub) (unless (elt sub 4) (setf (elt sub 4) (my-audio-braindump-get-subtitle-note-based-on-keywords (elt sub 3)))) sub) (subed-parse-file vtt-filename))) (start-date (my-audio-braindump-get-file-start-time vtt-filename)) chapters tags start-of-entry) (setq start-of-entry (point)) (insert (format "* TODO Review braindump from %s :braindump:\n\n" (file-name-base vtt-filename))) (org-entry-put (point) "CREATED" (concat "[" (format-time-string (cdr org-timestamp-formats) (my-audio-braindump-get-file-start-time (file-name-nondirectory vtt-filename))) "]")) (insert (format "%s - %s - %s\n" (org-link-make-string (concat "file:" (file-name-sans-extension vtt-filename) ".vtt") "VTT") (org-link-make-string (concat "file:" (file-name-sans-extension vtt-filename) ".txt") "Text") (org-link-make-string (concat "file:" (file-name-sans-extension vtt-filename) ".m4a") "Audio"))) (save-excursion (insert "** Transcript\n") ;; add each subtitle; add an ID in case we change the title (mapc (lambda (sub) (when (elt sub 4) (let ((note (my-audio-braindump-get-subtitle-note-based-on-keywords (elt sub 3)))) (insert (concat "*** " note " " (org-link-make-string (format "subed:%s::%s" vtt-filename (my-msecs-to-timestamp (elt sub 1))) "VTT") "\n\n")) (org-entry-put (point) "CREATED" (concat "[" (format-time-string (cdr org-timestamp-formats) (time-add start-date (seconds-to-time (/ (elt sub 1) 1000.0)))) "]")) (org-entry-put (point) "START" (my-msecs-to-timestamp (elt sub 2))) (when (elt sub 4) (when (string-match "command: .*recognize" (elt sub 4)) (save-excursion ;; TODO: scope this to just the section someday (goto-char start-of-entry) (org-set-tags (append (list "recognize") (org-get-tags))))) (when (string-match "command: .*outline" (elt sub 4)) (save-excursion (goto-char start-of-entry) (org-set-tags (append (list "outline") (org-get-tags))))) (when (string-match "^time" (elt sub 4)) (insert "[" (org-format-time-string (cdr org-timestamp-formats) (time-add start-date (seconds-to-time (/ (elt sub 1) 1000)))) "]\n")) (when (string-match "command: .+\\(high\\|low\\)" (elt sub 4)) (save-excursion (goto-char start-of-entry) (org-priority (if (string= (downcase (match-string 1)) "high") ?A ?C)))) (when (string-match "\\(?:tags?\\|keywords?\\): \\(.+\\)" (elt sub 4)) (save-excursion (goto-char start-of-entry) (org-set-tags (append (split-string (match-string 1) " ") (org-get-tags)))))) (add-to-list 'chapters (format "- %s (%s)" (org-link-make-string (concat "id:" (org-id-get-create)) note) (org-link-make-string (format "subed:%s::%s" vtt-filename (my-msecs-to-timestamp (elt sub 1))) "VTT"))))) (insert (elt sub 3) "\n")) subtitles)) (when chapters (insert (string-join (nreverse chapters) "\n") "\n"))))
Formatting the subtree
(defun my-file-start-time (filename &optional base-date) "Return the local time based on FILENAME." (setq filename (file-name-base filename)) (cond ((string-match "^\\([0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]\\)[-T]\\([0-9][0-9][\\.-][0-9][0-9]\\(?:[\\.-][0-9][0-9]\\)?\\)" filename) (date-to-time (concat (match-string 1 filename) "T" (replace-regexp-in-string "[\\.-]" ":" (match-string 2 filename))))) ((string-match "^\\(?:Copy of \\)?\\([^ ][^ ][^ ]\\)[^ ]+ at \\([0-9]+\\)-\\([0-9]+\\)" filename) (let* ((day (match-string 1 filename)) (hour (match-string 2 filename)) (min (match-string 3 filename)) (changed-time (or base-date (file-attribute-modification-time (file-attributes filename)))) (decoded-time (decode-time changed-time))) ;; get the day on or before changed-time (if (string= (format-time-string "%a" changed-time) day) (encode-time (append (list 0 (string-to-number min) (string-to-number hour)) (seq-drop decoded-time 3))) ;; synchronized maybe within the week after (let ((org-read-date-prefer-future nil)) (org-read-date t t (concat "--" day " " hour ":" min) nil changed-time))))))) (ert-deftest my-file-start-time () (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" (my-file-start-time "2024-01-05-09-46-59.flv")) "2024-01-05 09:46:59")) (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" (my-file-start-time "2024-01-08T12.49.vtt")) "2024-01-08 12:49:00")) (should (equal (format-time-string "%Y-%m-%d %H:%M:%S" (my-file-start-time "Sunday at 15-30.vtt" (date-to-time "2023-01-12"))) "2023-01-08 15:30:00")) (should (time-equal-p (my-file-start-time "Sunday at 12-49.txt") (org-read-date t t "-sun 12:49")))) (defalias 'my-audio-braindump-get-file-start-time #'my-file-start-time)
Process a single transcript from the raw text file
So now we put that all together: rename the file using the calculated start time, prepare the alignment breaks, align the file to get the timestamps, and add the subtree to an Org file.
Making the TODO
(defvar my-audio-braindump-file "~/sync/orgzly/braindump.org") (defun my-audio-braindump-make-todo (text-file &optional force) "Add TEXT-FILE as a TODO." (interactive (list (buffer-file-name) current-prefix-arg)) ;; rename the files to use the timestamps (unless (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" (file-name-base text-file)) (setq text-file (my-audio-braindump-rename-files-based-on-time text-file))) (let* ((recording (concat (file-name-sans-extension text-file) ".m4a")) (start (my-audio-braindump-get-file-start-time text-file)) (vtt (concat (file-name-sans-extension text-file) ".vtt")) chapters (title (concat "Review braindump " text-file)) existing) ;; check if already exists (with-current-buffer (find-file-noselect my-audio-braindump-file) (save-excursion (goto-char (point-min)) (setq existing (org-find-exact-headline-in-buffer title)))) (if (and existing (not force)) (progn (message "Going to existing heading") (org-goto-marker-or-bmk existing)) (if (or (null my-audio-braindump-last-processed-time) (time-less-p my-audio-braindump-last-processed-time start)) (customize-save-variable 'my-audio-braindump-last-processed-time start)) (find-file text-file) (my-audio-braindump-prepare-alignment-breaks) (save-buffer) (when (file-exists-p vtt) (delete-file vtt)) (when (get-file-buffer vtt) (kill-buffer (get-file-buffer vtt))) (subed-align recording text-file "VTT") (when (get-file-buffer vtt) (kill-buffer (get-file-buffer vtt))) (find-file my-audio-braindump-file) (goto-char (point-min)) (if existing (progn (org-goto-marker-or-bmk existing) (delete-region (point) (org-end-of-subtree))) (org-next-visible-heading 1)) (my-audio-braindump-insert-subtitles-as-org-tree vtt))))
Process multiple files
I want to process multiple files in one batch.
(defun my-audio-braindump-process (files &optional force) (interactive (list (cond ((and (derived-mode-p 'dired-mode) (dired-get-marked-files)) (dired-get-marked-files)) ((derived-mode-p 'dired-mode) (list (dired-get-filename))) ((string-match "\\.txt$" (buffer-file-name)) (list (buffer-file-name))) (t (read-file-name "Transcript: "))) current-prefix-arg)) (mapc (lambda (f) (when (string-match "txt" f) (my-audio-braindump-make-todo f force))) files))
It would be nice to have it automatically keep track of the latest one
that's been processed, maybe via customize-save-variable
. This still
needs some tinkering with.
Processing new files
(defcustom my-audio-braindump-last-processed-time nil "The timestamp of the last processed transcript." :group 'sacha :type '(repeat integer)) (defun my-audio-braindump-process-since-last () (interactive) (let ((files (seq-filter (lambda (f) (or (null my-audio-braindump-last-processed-time) (time-less-p my-audio-braindump-last-processed-time (my-audio-braindump-get-file-start-time f)))) (directory-files my-phone-recording-dir 'full " at [0-9][0-9]-[0-9][0-9]\\.txt\\|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]T[0-9][0-9]\\.[0-9][0-9]\\.txt")))) (mapc (lambda (f) (my-audio-braindump-make-todo f) (let ((start (my-audio-braindump-get-file-start-time f))) (if (time-less-p my-audio-braindump-last-processed-time start) (setq my-audio-braindump-last-processed-time start)))) files)) (customize-save-variable 'my-audio-braindump-last-processed-time my-audio-braindump-last-processed-time)) (defun my-audio-braindump-new-filename (text-file &optional base-date) (if (string-match "^[0-9][0-9][0-9][0-9]" text-file) text-file ; no change, already uses date (let* ((base (file-name-base text-file)) (start (my-audio-braindump-get-file-start-time base base-date)) (rest (if (string-match "^\\([-0-9T\\.]+\\|\\(?:.+? at [0-9][0-9]-[0-9][0-9]\\)\\)\\( .+\\)" base) (match-string 2 base) "")) (new-base (format-time-string "%Y-%m-%dT%H.%M" start))) (concat new-base rest "." (file-name-extension text-file))))) (ert-deftest my-audio-braindump-new-filename () (should (equal (my-audio-braindump-new-filename "Wednesday at 18-58.txt" (date-to-time "2023-01-01")) "2022-12-28T18.58.txt")) (should (equal (my-audio-braindump-new-filename "Wednesday at 18-58 extra text.txt" (date-to-time "2023-01-01")) "2022-12-28T18.58 extra text.txt"))) (defun my-audio-braindump-rename-files-based-on-time (text-file) "Rename TEXT-FILE based on date. Return the new text file." (interactive (list (if (derived-mode-p 'dired-mode) (dired-get-filename) (buffer-file-name)))) (if (string-match "^[0-9][0-9][0-9][0-9]" text-file) text-file ; no change, already uses date (let ((new-name (my-audio-braindump-new-filename (file-name-nondirectory text-file)))) (if (file-exists-p (expand-file-name new-name (file-name-directory text-file))) (error "%s already exists" new-base) (dolist (ext '(".txt" ".m4a" ".vtt")) (if (file-exists-p (concat (file-name-sans-extension text-file) ext)) (rename-file (concat (file-name-sans-extension text-file) ext) (expand-file-name (concat (file-name-sans-extension new-name) ext) (file-name-directory text-file))))) (expand-file-name new-name (file-name-directory text-file))))))
Ideas for next steps
- Make the commands process things even more automatically.
- Experiment with just sending everything to OpenAI Whisper instead of conditionally sending it based on the keywords (which might not be recognized).
- See if I want to reuse more sentences or move them around.
- Find out where people who have thought about dictation keywords have their notes; probably don't have to reinvent the wheel here
DONE Updating my audio braindump workflow to take advantage of WhisperX speechtotext org
I get word timestamps for free when I transcribe with WhisperX, so I can skip the Aeneas alignment step. That means I can update my previous code for handling audio braindumps . Breaking the transcript up into sections Also, I recently updated subed-word-data to colour words based on their transcription score, which draws my attention to things that might be uncertain.
Here's what it looks like when I have the post, the transcript, and the annotated PDF.
Here's what I needed to implement my-audio-braindump-from-whisperx-json
(plus some code from my previous audio braindump workflow):
(defun my-whisperx-word-list (file) (let* ((json-object-type 'alist) (json-array-type 'list)) (seq-mapcat (lambda (seg) (alist-get 'words seg)) (alist-get 'segments (json-read-file file))))) ;; (seq-take (my-whisperx-word-list (my-latest-file "~/sync/recordings" "\\.json")) 10) (defun my-whisperx-insert-word-list (words) "Inserts WORDS with text properties." (require 'subed-word-data) (mapc (lambda (word) (let ((start (point))) (insert (alist-get 'word word)) (subed-word-data--add-word-properties start (point) word) (insert " "))) words)) (defun my-audio-braindump-turn-sections-into-headings () (interactive) (goto-char (point-min)) (while (re-search-forward "START SECTION \\(.+?\\) STOP SECTION" nil t) (replace-match (save-match-data (format "\n*** %s\n" (save-match-data (string-trim (replace-regexp-in-string "^[,\\.]\\|[,\\.]$" "" (match-string 1)))))) nil t) (let ((prop-match (save-excursion (text-property-search-forward 'subed-word-data-start)))) (when prop-match (org-entry-put (point) "START" (format-seconds "%02h:%02m:%02s" (prop-match-value prop-match))))))) (defun my-audio-braindump-split-sentences () (interactive) (goto-char (point-min)) (while (re-search-forward "[a-z]\\. " nil t) (replace-match (concat (string-trim (match-string 0)) "\n") ))) (defun my-audio-braindump-restructure () (interactive) (goto-char (point-min)) (my-subed-fix-common-errors) (org-mode) (my-audio-braindump-prepare-alignment-breaks) (my-audio-braindump-turn-sections-into-headings) (my-audio-braindump-split-sentences) (goto-char (point-min)) (my-remove-filler-words-at-start)) (defun my-audio-braindump-from-whisperx-json (file) (interactive (list (read-file-name "JSON: " "~/sync/recordings/" nil nil nil (lambda (f) (string-match "\\.json\\'" f))))) ;; put them all into a buffer (with-current-buffer (get-buffer-create "*Words*") (erase-buffer) (fundamental-mode) (my-whisperx-insert-word-list (my-whisperx-word-list file)) (my-audio-braindump-restructure) (goto-char (point-min)) (switch-to-buffer (current-buffer)))) (defun my-audio-braindump-process-text (file) (interactive (list (read-file-name "Text: " "~/sync/recordings/" nil nil nil (lambda (f) (string-match "\\.txt\\'" f))))) (with-current-buffer (find-file-noselect file) (my-audio-braindump-restructure) (save-buffer))) ;; (my-audio-braindump-from-whisperx-json (my-latest-file "~/sync/recordings" "\\.json"))
Ideas for next steps:
- I can change my processing script to split up the Whisper TXT into sections and automatically make the PDF with nice sections.
- I can add reminders and other callouts. I can style them, and I can copy reminders into a different section for easier processing.
- I can look into extracting PDF annotations so that I can jump to the next highlight or copy highlighted text.
Markdown
(use-package markdown-mode :if my-laptop-p :mode ("\\.\\(njk\\|md\\)\\'" . markdown-mode))
Screenshot
Based on https://www.reddit.com/r/emacs/comments/idz35e/emacs_27_can_take_svg_screenshots_of_itself/
(defun screenshot-svg () "Save a screenshot of the current frame as an SVG image. Saves to a temp file and puts the filename in the kill ring." (interactive) (let* ((filename (expand-file-name (format-time-string "%Y-%m-%d-%H-%M-%S.svg") my-recordings-dir)) (data (x-export-frames nil 'svg))) (with-temp-file filename (insert data)) (kill-new filename) (message filename))) (keymap-global-set "C-c s" #'screenshot-svg)
Avoiding weasel words
(use-package artbollocks-mode :if my-laptop-p :defer t :load-path "~/elisp/artbollocks-mode" :config (progn (setq artbollocks-weasel-words-regex (concat "\\b" (regexp-opt '("one of the" "should" "just" "sort of" "a lot" "probably" "maybe" "perhaps" "I think" "really" "pretty" "nice" "action" "utilize" "leverage") t) "\\b")) ;; Don't show the art critic words, or at least until I figure ;; out my own jargon (setq artbollocks-jargon nil)))
Unfill paragraph
I unfill paragraphs a lot because Wordpress likes adding extra <br>
tags if I don't. (I should probably just tweak my Wordpress installation.)
(defun my-unfill-paragraph (&optional region) "Takes a multi-line paragraph and makes it into a single line of text." (interactive (progn (barf-if-buffer-read-only) (list t))) (let ((fill-column (point-max))) (fill-paragraph nil region))) (bind-key "M-Q" 'my-unfill-paragraph)
I never actually justify text, so I might as well change the way
fill-paragraph
works. With the code below, M-q
will fill the
paragraph normally, and C-u M-q
will unfill it.
(defun my-fill-or-unfill-paragraph (&optional unfill region) "Fill paragraph (or REGION). With the prefix argument UNFILL, unfill it instead." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'unfill) t))) (let ((fill-column (if unfill (point-max) fill-column))) (fill-paragraph nil region))) (bind-key "M-q" 'my-fill-or-unfill-paragraph)
Also, visual-line-mode
is so much better than auto-fill-mode
. It doesn't actually break the text into multiple lines - it only looks that way.
(remove-hook 'text-mode-hook #'turn-on-auto-fill) (add-hook 'text-mode-hook 'turn-on-visual-line-mode)
Unicode
(defmacro my-insert-unicode (unicode-name) `(lambda () (interactive) (insert-char (cdr (assoc-string ,unicode-name (ucs-names)))))) (bind-key "C-x 8 s" (my-insert-unicode "ZERO WIDTH SPACE")) (bind-key "C-x 8 S" (my-insert-unicode "SNOWMAN"))
Clean up spaces
(bind-key "M-SPC" 'cycle-spacing)
Expand
(setq save-abbrevs 'silently) (bind-key "M-/" 'hippie-expand)
From https://github.com/purcell/emacs.d/blob/master/lisp/init-auto-complete.el - Exclude very large buffers from dabbrev
(defun sanityinc/dabbrev-friend-buffer (other-buffer) (< (buffer-size other-buffer) (* 1 1024 1024))) (setq dabbrev-friend-buffer-function 'sanityinc/dabbrev-friend-buffer)
(setq hippie-expand-try-functions-list '(yas-hippie-try-expand try-expand-all-abbrevs try-complete-file-name-partially try-complete-file-name try-expand-dabbrev try-expand-dabbrev-from-kill try-expand-dabbrev-all-buffers try-expand-list try-expand-line try-complete-lisp-symbol-partially try-complete-lisp-symbol))
Write about keybindings
;; hmm, doesn't quite work for looking things up yet. I basically want a programmatic where-is for a specific keymap (defvar my-keybinding-maps '(subed-mode-map subed-waveform-minor-mode-map subed-waveform-svg-map)) (defun my-copy-keybinding (symbol) (interactive (list (find-function-read))) (when (listp symbol) (setq symbol (car symbol))) (let (result keys) (map-keymap (lambda (event def) (cond ((and (symbolp def)) (push (list def event) result)) ((and (listp def) (eq 'keymap (car def))) (apply 'append (map-keymap (lambda (event def) (when (and (symbolp def)) (push (list def event) result))) def))))) subed-mode-map) (setq keys (assoc-default symbol result)) (when keys (kill-new (key-description keys)) (message "%s" (key-description keys)))))
Transcripts from my phone audio editing
(defvar my-audio-braindump-dir "~/sync/Phone") (defun my-open-latest-braindump () (interactive) (find-file (my-latest-file my-audio-braindump-dir "\\.txt")) (kill-new (buffer-string))) (defun my-insert-latest-braindump () (interactive) (insert-file-contents (my-latest-file my-audio-braindump-dir "\\.txt"))) (defun my-audio-braindump-dired () (interactive) (dired my-audio-braindump-dir "-lt")) (defalias 'my-phone-dired #'my-audio-braindump-dired)
Speech recognition audio
TOBLOG Using Emacs Lisp to send audio files to Deepgram and format VTTs emacs speech
I've been experimenting with Deepgram's API for speech recognition because it can handle larger files than OpenAI Whisper's API, so I don't have to worry about chunking my files into 15-minute segments. It also supports diarization, which means identifying different speakers. That's handy for things like the EmacsConf Q&A sessions, which involve multiple people.
I think the built-in VTT formatter doesn't handle speaker
identification, so I wrote some Emacs Lisp to send an audio
file for recognition, save the JSON, and format the results
as a VTT subtitle file. I also split the captions a little
closer to the way I like to do them, starting a new subtitle
if the line exceeds my-deepgram-length-threshold
or
my-deepgram-time-threshold
, or if we're after a punctuated
word and the current subtitle is more than halfway to the
length threshold. Someday I'll figure out how to get it to
split on prepositions.
(defvar my-deepgram-length-threshold 45 "Number of characters.") (defvar my-deepgram-time-threshold 10 "Number of seconds since the first word.") (defun my-deepgram-recognize-audio (audio-file &optional diarize) "Send AUDIO-FILE to Deepgram, save the JSON, and create a VTT. If DIARIZE is non-nil, identify speakers." (require 'subed) (interactive (list (if (auth-info-password (car (auth-source-search :host "https://api.deepgram.com"))) (read-file-name "Audio file: ") (error "Please put deepgram API key in auth sources.")))) (with-current-buffer (get-buffer-create "*Deepgram*") (erase-buffer) (unless (string-match "\\(opus\\|wav\\|mp3\\)$" audio-file) (if (file-exists-p (concat (file-name-sans-extension audio-file) ".opus")) (setq audio-file (concat (file-name-sans-extension audio-file) ".opus")) (call-process "ffmpeg" nil t t "-i" (expand-file-name audio-file) "-ac" "1" "-y" (expand-file-name (concat (file-name-sans-extension audio-file) ".opus"))) (setq audio-file (concat (file-name-sans-extension audio-file) ".opus")))) (unless (file-exists-p (expand-file-name (concat (file-name-sans-extension audio-file) ".json"))) (call-process "curl" nil t t "--request" "POST" "--header" (concat "Authorization: Token " (auth-info-password (car (auth-source-search :host "https://api.deepgram.com")))) "--header" (concat "Content-Type: " (mailcap-file-name-to-mime-type audio-file)) "--data-binary" (concat "@" (expand-file-name audio-file)) "--url" (concat "https://api.deepgram.com/v1/listen?punctuate=true&model=whisper-large&smart_format=true&utterances=true" (if diarize "&diarize=true" "")) "-o" (expand-file-name (concat (file-name-sans-extension audio-file) ".json")))) (my-deepgram-convert-json-to-vtt (concat (file-name-sans-extension audio-file) ".json"))) (find-file (concat (file-name-sans-extension audio-file) ".vtt"))) (defun my-emacsconf-extract-deepgram-recognize-qa-for-talk (talk) "Send the QA (or main) Opus file for TALK to Deepgram. Save the results as JSON and VTT." (interactive (list (emacsconf-complete-talk-info))) (setq talk (emacsconf-resolve-talk talk)) (if (or (emacsconf-talk-file talk "--answers--original.json") (emacsconf-talk-file talk "--original.json")) (message "Files already exist for %s" (plist-get talk :slug)) (if-let ((file (or (emacsconf-talk-file talk "--answers--original.opus") (emacsconf-talk-file talk "--original.opus")))) (my-deepgram-recognize-audio file) (error "No file to recognize for %s" (plist-get talk :slug))))) (defun my-deepgram-parse (json-file) "Convert JSON-FILE into a list of subtitles." (let* ((json-object-type 'alist) (json (json-read-file json-file)) (words (assoc-default 'words (aref (assoc-default 'alternatives (aref (let-alist json .results.channels) 0)) 0))) (halfway-length (/ my-deepgram-length-threshold 2)) subtitles current current-length last-speaker last-text current-text) (dolist (speaker (seq-group-by (lambda (o) (assoc-default 'speaker o)) words)) (setq current-length 0 current nil) (dolist (word (cdr speaker)) (let-alist word ;; determine whether we are adding to the existing one. ;; start a new one if length > length-threshold ;; or time > time-threshold (when (or (> (+ (length .punctuated_word) current-length) my-deepgram-length-threshold) (and (car current) (> .start (+ (assoc-default 'start (car current)) my-deepgram-time-threshold)))) ;; copy the previous subtitle (push current subtitles) (setq current nil current-length 0)) (push word current) (setq current-length (+ (length .punctuated_word) current-length 1)) (when (and (string-match "[,\\.?]" .punctuated_word) (> current-length halfway-length)) (push current subtitles) (setq current nil current-length 0)))) (when current (push current subtitles))) (seq-keep (lambda (entry) (setq current-text (mapconcat (lambda (w) (assoc-default 'punctuated_word w)) (reverse entry) " ")) (when (not (string= (downcase current-text) (or last-text ""))) (setq last-text (downcase current-text)) (list nil (* (assoc-default 'start (car (last entry)) nil 0) 1000) (* (assoc-default 'end (car entry) nil 0) 1000) ;; add speaker tag? (concat (if (and (assoc-default 'speaker (car entry)) (or (null last-speaker) (not (eq last-speaker (assoc-default 'speaker (car entry)))))) (progn (setq last-speaker (assoc-default 'speaker (car entry))) (format "[Speaker %d]: " (assoc-default 'speaker (car entry)))) "") current-text )))) (sort subtitles (lambda (a b) ;; sort by time (< (assoc-default 'start (car a) nil 0) (assoc-default 'start (car b) nil 0))))))) (defun my-deepgram-convert-json-to-vtt (json-file &optional force) (interactive (list (read-file-name "JSON: ") current-prefix-arg)) "Convert JSON-FILE into a VTT." (subed-create-file (concat (file-name-sans-extension json-file) ".vtt") (my-deepgram-parse json-file) force)) (defconst deepgram-whisper-large-per-min 0.0048) (defun my-deepgram-cost (file) (interactive "FFile: ") (let* ((whisper-large-per-min deepgram-whisper-large-per-min) (nova2-streaming-per-min 0.0059) (duration (/ (ceiling (/ (compile-media-get-file-duration-ms file) 1000.0)) 60)) (msg (format "%.1f minutes: USD %.2f batch, USD %.2f streaming" duration (* duration whisper-large-per-min) (* duration nova2-streaming-per-min)))) (when (called-interactively-p 'any) (message "%s" msg) (kill-new msg)) (list duration (* duration whisper-large-per-min) (* duration nova2-streaming-per-min))))
TOBLOG Rerecognize this audio and reprocess it
(defun my-audio-braindump-reprocess (audio-file) (interactive (list (let ((default (cond ((derived-mode-p 'org-mode) (save-excursion (org-back-to-heading) (when (re-search-forward "\\[Audio\\]" nil (save-excursion (org-end-of-subtree))) (org-element-property :path (org-element-context))))) ((file-exists-p (concat (file-name-sans-extension (buffer-file-name)) ".m4a")) (concat (file-name-sans-extension (buffer-file-name)) ".m4a"))))) (read-file-name (if default (format "Audio (%s): " default) "Audio: ") nil default)))) (save-window-excursion (unless (file-exists-p (concat (file-name-sans-extension audio-file) ".json")) (my-deepgram-recognize-audio audio-file)) (with-temp-file (concat (file-name-sans-extension audio-file) ".txt") (insert (subed-subtitle-list-text (my-deepgram-parse (concat (file-name-sans-extension audio-file) ".json")))) (goto-char (point-min)) (my-audio-braindump-prepare-alignment-breaks)) (with-current-buffer (find-file-noselect (concat (file-name-sans-extension audio-file) ".txt")) (subed-align audio-file (concat (file-name-sans-extension audio-file) ".txt") "VTT"))) (find-file my-audio-braindump-braindump-file) (goto-char (point-min)) (my-audio-braindump-insert-subtitles-as-org-tree (concat (file-name-sans-extension audio-file) ".vtt")))
Gladia
(defun my-gladia-parse (json-file) "Convert JSON-FILE into a list of subtitles." (let* ((json-object-type 'alist) (json (json-read-file json-file)) (words (seq-mapcat (lambda (pred) (seq-map (lambda (w) (append (list (cons 'speaker (when (not (string= "speaker_not_activated" (assoc-default 'speaker pred))) (assoc-default 'speaker pred))) (cons 'start (assoc-default 'time_begin pred)) (cons 'end (assoc-default 'time_end pred)) (cons 'punctuated_word (string-trim (assoc-default 'word w)))) w)) (assoc-default 'words pred))) (assoc-default 'prediction json))) (halfway-length (/ my-deepgram-length-threshold 2)) subtitles current current-length last-speaker last-text current-text) (dolist (speaker (seq-group-by (lambda (o) (assoc-default 'speaker o)) words)) (setq current-length 0 current nil) (dolist (word (cdr speaker)) (let-alist word ;; determine whether we are adding to the existing one. ;; start a new one if length > length-threshold ;; or time > time-threshold (when (or (> (+ (length .punctuated_word) current-length) my-deepgram-length-threshold) (and (car current) (> .start (+ (assoc-default 'start (car current)) my-deepgram-time-threshold)))) ;; copy the previous subtitle (push current subtitles) (setq current nil current-length 0)) (push word current) (setq current-length (+ (length .punctuated_word) current-length 1)) (when (and (string-match "[,\\.?]" .punctuated_word) (> current-length halfway-length)) (push current subtitles) (setq current nil current-length 0)))) (when current (push current subtitles))) (seq-keep (lambda (entry) (setq current-text (mapconcat (lambda (w) (assoc-default 'punctuated_word w)) (nreverse entry) " ")) (when (not (string= (downcase current-text) (or last-text ""))) (setq last-text (downcase current-text)) (list nil (* (assoc-default 'start (car entry) nil 0) 1000) (* (assoc-default 'end (car (last entry)) nil 0) 1000) ;; add speaker tag? (concat (if (and (assoc-default 'speaker (car entry)) (or (null last-speaker) (not (eq last-speaker (assoc-default 'speaker (car entry)))))) (progn (setq last-speaker (assoc-default 'speaker (car entry))) (format "[Speaker %s]: " (assoc-default 'speaker (car entry)))) "") current-text )))) (sort subtitles (lambda (a b) ;; sort by time (< (assoc-default 'start (car a) nil 0) (assoc-default 'start (car b) nil 0))))))) (defun my-gladia-recognize-audio (audio-file &optional diarize other-options) "Send AUDIO-FILE to Gladia, save the JSON, and create a VTT. If DIARIZE is non-nil, identify speakers." (interactive (list (if (getenv "GLADIA_API_KEY") (read-file-name "Audio file: ") (error "Please specify GLADIA_API_KEY.")))) (with-current-buffer (get-buffer-create "*recognition*") (erase-buffer) (call-process "curl" nil t t "--request" "POST" "--header" (concat "x-gladia-key: " (getenv "GLADIA_API_KEY")) "--header" (concat "Content-Type: multipart/form-data" ) "--header" (concat "Accept: application/json") "-F" (concat "audio=@" (expand-file-name audio-file) ";type=" (mailcap-file-name-to-mime-type audio-file)) "-F" (concat "toggle_noise_reduction=true&output_format=json" (or other-options "") (if diarize "&toggle_diarization=true" "")) "--url" "https://api.gladia.io/audio/text/audio-transcription?toggle_noise_reduction=true&output_format=json" "-o" (expand-file-name (concat (file-name-sans-extension audio-file) ".json"))) (subed-create-file (concat (file-name-sans-extension audio-file) ".vtt") (my-gladia-parse (concat (file-name-sans-extension audio-file) ".json")))) (find-file (concat (file-name-sans-extension audio-file) ".vtt")))
DONE Getting live speech into Emacs with Deepgram's streaming API emacs speech
- getting live speech from Emacs into Etherpad : Reorganized code to call a list of functions and pass the recognition results. Added Etherpad. Took out the mode; will just use the functions. Related:
This is a quick demonstration of using Deepgram's streaming API to do speech recognition live. It isn't as accurate as OpenAI Whisper but since Whisper doesn't have a streaming API, it'll do for now. I can correct misrecognized words manually. I tend to talk really quickly, so it displays the words per minute in my modeline. I put the words into an Org Mode buffer so I can toggle headings with avy and cycle visibility. When I'm done, it saves the text, JSON, and WAV for further processing. I think it'll be handy to have a quick way to take live notes during interviews or when I'm thinking out loud. Could be fun!
I'm still getting some weirdness when the mode turns on when I don't
expect it, so that's something to look into. Maybe I won't use it as a
mode for now. I'll just use my-live-speech-start
and
my-live-speech-stop
.
General code
(defvar my-live-speech-buffer "*Speech*") (defvar my-live-speech-process nil) (defvar my-live-speech-output-buffer "*Speech JSON*") (defvar my-live-speech-functions '(my-live-speech-display-in-speech-buffer my-live-speech-display-wpm my-live-speech-append-to-etherpad) "Functions to call with one argument, the recognition results.") (defun my-live-speech-start () "Turn on live captions." (interactive) (with-current-buffer (get-buffer-create my-live-speech-buffer) (unless (process-live-p my-live-speech-process) (let ((default-directory "~/proj/deepgram-live")) (message "%s" default-directory) (with-current-buffer (get-buffer-create my-live-speech-output-buffer) (erase-buffer)) (setq my-live-speech-recent-words nil my-live-speech-wpm-string "READY ") (setq my-deepgram-process (make-process :command '("bash" "run.sh") :name "speech" :filter 'my-live-speech-json-filter :sentinel #'my-live-speech-process-sentinel :buffer my-live-speech-output-buffer))) (org-mode)) (display-buffer (current-buffer)))) (defun my-live-speech-stop () (interactive) (if (process-live-p my-live-speech-process) (kill-process my-live-speech-process)) (setq my-live-speech-wpm-string nil)) ;; (define-minor-mode my-live-speech-mode ;; "Show live speech and display WPM. ;; Need to check how to reliably turn this on and off." ;; :global t :group 'sachac ;; (if my-live-speech-mode ;; (my-live-speech-start) ;; (my-live-speech-stop) ;; (setq my-live-speech-wpm-string nil))) ;; based on subed-mpv::client-filter (defun my-live-speech-handle-json (line-object) "Process the JSON object in LINE." (run-hook-with-args 'my-live-speech-functions (json-parse-string line :object-type 'alist))) (defun my-live-speech-process-sentinel (proc event) (when (string-match "finished" event) (my-live-speech-stop) ;(my-live-speech-mode -1) )) (defun my-live-speech-json-filter (proc string) (when (buffer-live-p (process-buffer proc)) (with-current-buffer (process-buffer proc) (let* ((proc-mark (process-mark proc)) (moving (= (point) proc-mark))) ;; insert the output (save-excursion (goto-char proc-mark) (insert string) (set-marker proc-mark (point))) (if moving (goto-char proc-mark)) ;; process and remove all complete lines of JSON (lines are complete if ending with \n) (let ((pos (point-min))) (while (progn (goto-char pos) (end-of-line) (equal (following-char) ?\n)) (let* ((end (point)) (line (buffer-substring pos end))) (delete-region pos (+ end 1)) (with-current-buffer (get-buffer my-live-speech-buffer) (my-live-speech-handle-json line)))))))))
Python code based on the Deepgram streaming test suite:
Very rough app.py
# Based on streaming-test-suite # https://developers.deepgram.com/docs/getting-started-with-the-streaming-test-suite import pyaudio import asyncio import json import os import websockets from datetime import datetime import wave import sys startTime = datetime.now() key = os.environ['DEEPGRAM_API_KEY'] live_json = os.environ.get('LIVE_CAPTIONS_JSON', True) all_mic_data = [] all_transcripts = [] all_words = [] FORMAT = pyaudio.paInt16 CHANNELS = 1 RATE = 16000 CHUNK = 8000 audio_queue = asyncio.Queue() REALTIME_RESOLUTION = 0.250 SAMPLE_SIZE = 0 def save_info(): global SAMPLE_SIZE base = startTime.strftime('%Y%m%d%H%M') wave_file_path = os.path.abspath(f"{base}.wav") wave_file = wave.open(wave_file_path, "wb") wave_file.setnchannels(CHANNELS) wave_file.setsampwidth(SAMPLE_SIZE) wave_file.setframerate(RATE) wave_file.writeframes(b"".join(all_mic_data)) wave_file.close() with open(f"{base}.txt", "w") as f: f.write("\n".join(all_transcripts)) with open(f"{base}.json", "w") as f: f.write(json.dumps(all_words)) if live_json: print(f'{{"msg": "🟢 Saved to {base}.txt , {base}.json , {base}.wav", "base": "{base}"}}') else: print(f"🟢 Saved to {base}.txt , {base}.json , {base}.wav") # Used for microphone streaming only. def mic_callback(input_data, frame_count, time_info, status_flag): audio_queue.put_nowait(input_data) return (input_data, pyaudio.paContinue) async def run(key, method="mic", format="text", **kwargs): deepgram_url = f'wss://api.deepgram.com/v1/listen?punctuate=true&smart_format=true&utterances=true&encoding=linear16&sample_rate=16000' async with websockets.connect( deepgram_url, extra_headers={"Authorization": "Token {}".format(key)} ) as ws: async def sender(ws): try: while True: mic_data = await audio_queue.get() all_mic_data.append(mic_data) await ws.send(mic_data) except websockets.exceptions.ConnectionClosedOK: await ws.send(json.dumps({"type": "CloseStream"})) if live_json: print('{"msg": "Closed."}') else: print("Closed.") async def receiver(ws): global all_words """Print out the messages received from the server.""" first_message = True first_transcript = True transcript = "" async for msg in ws: res = json.loads(msg) if first_message: first_message = False try: # handle local server messages if res.get("msg"): if live_json: print(json.dumps(res)) else: print(res["msg"]) if res.get("is_final"): transcript = ( res.get("channel", {}) .get("alternatives", [{}])[0] .get("transcript", "") ) if transcript != "": if first_transcript: first_transcript = False if live_json: print(json.dumps(res.get("channel", {}).get("alternatives", [{}])[0])) else: print(transcript) all_transcripts.append(transcript) all_words = all_words + res.get("channel", {}).get("alternatives", [{}])[0].get("words", []) # if using the microphone, close stream if user says "goodbye" if method == "mic" and "goodbye" in transcript.lower(): await ws.send(json.dumps({"type": "CloseStream"})) if live_json: print('{"msg": "Done."}') else: print("Done.") # handle end of stream if res.get("created"): save_info() except KeyError: print(f"🔴 ERROR: Received unexpected API response! {msg}") # Set up microphone if streaming from mic async def microphone(): audio = pyaudio.PyAudio() stream = audio.open( format=FORMAT, channels=CHANNELS, rate=RATE, input=True, frames_per_buffer=CHUNK, stream_callback=mic_callback, ) stream.start_stream() global SAMPLE_SIZE SAMPLE_SIZE = audio.get_sample_size(FORMAT) while stream.is_active(): await asyncio.sleep(0.1) stream.stop_stream() stream.close() functions = [ asyncio.ensure_future(sender(ws)), asyncio.ensure_future(receiver(ws)), ] functions.append(asyncio.ensure_future(microphone())) if live_json: print('{"msg": "Ready."}') else: print("🟢 Ready.") await asyncio.gather(*functions) def main(): """Entrypoint for the example.""" # Parse the command-line arguments. try: asyncio.run(run(key, "mic", "text")) except websockets.exceptions.InvalidStatusCode as e: print(f'🔴 ERROR: Could not connect to Deepgram! {e.headers.get("dg-error")}') print( f'🔴 Please contact Deepgram Support (developers@deepgram.com) with request ID {e.headers.get("dg-request-id")}' ) return except websockets.exceptions.ConnectionClosedError as e: error_description = f"Unknown websocket error." print( f"🔴 ERROR: Deepgram connection unexpectedly closed with code {e.code} and payload {e.reason}" ) if e.reason == "DATA-0000": error_description = "The payload cannot be decoded as audio. It is either not audio data or is a codec unsupported by Deepgram." elif e.reason == "NET-0000": error_description = "The service has not transmitted a Text frame to the client within the timeout window. This may indicate an issue internally in Deepgram's systems or could be due to Deepgram not receiving enough audio data to transcribe a frame." elif e.reason == "NET-0001": error_description = "The service has not received a Binary frame from the client within the timeout window. This may indicate an internal issue in Deepgram's systems, the client's systems, or the network connecting them." print(f"🔴 {error_description}") # TODO: update with link to streaming troubleshooting page once available # print(f'🔴 Refer to our troubleshooting suggestions: ') print( f"🔴 Please contact Deepgram Support (developers@deepgram.com) with the request ID listed above." ) return except websockets.exceptions.ConnectionClosedOK: return except Exception as e: print(f"🔴 ERROR: Something went wrong! {e}") save_info() return if __name__ == "__main__": sys.exit(main() or 0)
The Python script sends the microphone stream to Deepgram and prints out the JSON output. The Emacs Lisp code starts an asynchronous process and reads the JSON output, displaying the transcript and calculating the WPM based on the words. run.sh just loads the venv for this project (requirements.txt based on the streaming text suite) and then runs app.py, since some of the Python library versions conflict with other things I want to experiment with.
I also added
my-live-speech-wpm-string
to my mode-line-format
manually using
Customize, since I wanted it displayed on the left side instead of
getting lost when I turn keycast-mode
on.
I'm still a little anxious about accidentally leaving a process
running, so I check with ps aux | grep python3
. Eventually I'll
figure out how to make sure everything gets properly stopped when I'm
done.
Anyway, there it is!
Display in speech buffer
(defun my-live-speech-display-in-speech-buffer (recognition-results) (with-current-buffer (get-buffer-create my-live-speech-buffer) (let-alist recognition-results (let* ((pos (point)) (at-end (eobp))) (goto-char (point-max)) (unless (eolp) (insert "\n")) (when .msg (insert .msg "\n")) (when .transcript (insert .transcript "\n")) ;; scroll to the bottom if being displayed (if at-end (when (get-buffer-window (current-buffer)) (set-window-point (get-buffer-window (current-buffer)) (point))) (goto-char pos)))))) (defun my-live-speech-toggle-heading () "Toggle a line as a heading." (interactive) (with-current-buffer (get-buffer my-live-speech-buffer) (display-buffer (current-buffer)) (with-selected-window (get-buffer-window (get-buffer my-live-speech-buffer)) (let ((avy-all-windows nil)) (avy-goto-line 1)) (org-toggle-heading 1)))) (defun my-live-speech-cycle-visibility () "Get a quick overview." (interactive) (with-current-buffer (get-buffer my-live-speech-buffer) (display-buffer (current-buffer)) (if (eq org-cycle-global-status 'contents) (progn (run-hook-with-args 'org-cycle-pre-hook 'all) (org-fold-show-all '(headings blocks)) (setq org-cycle-global-status 'all) (run-hook-with-args 'org-cycle-hook 'all)) (run-hook-with-args 'org-cycle-pre-hook 'contents) (org-cycle-content) (setq org-cycle-global-status 'contents) (run-hook-with-args 'org-cycle-hook 'contents))))
Display words per minute
(defvar my-live-speech-wpm-window-seconds 15 "How many seconds to calculate WPM for.") (defvar my-live-speech-recent-words nil "Words spoken in `my-live-speech-wpm-window-minutes'.") (defvar my-live-speech-wpm nil "Current WPM.") (defvar my-live-speech-wpm-colors ; haven't figured out how to make these work yet '((180 :foreground "red") (170 :foreground "yellow") (160 :foreground "green"))) (defvar my-live-speech-wpm-string nil "Add this somewhere in `mode-line-format'.") (defun my-live-speech-wpm-string () (propertize (format "%d WPM " my-live-speech-wpm) 'face (cdr (seq-find (lambda (row) (> my-live-speech-wpm (car row))) my-live-speech-wpm-colors)))) (defun my-live-speech-display-wpm (recognition-results) (let-alist recognition-results (when .words ;; calculate WPM (setq my-live-speech-recent-words (append my-live-speech-recent-words .words nil)) (let ((threshold (- (assoc-default 'end (aref .words (1- (length .words)))) my-live-speech-wpm-window-seconds))) (setq my-live-speech-recent-words (seq-filter (lambda (o) (>= (assoc-default 'start o) threshold)) my-live-speech-recent-words)) (setq my-live-speech-wpm (/ (length my-live-speech-recent-words) (/ (- (assoc-default 'end (aref .words (1- (length .words)))) (assoc-default 'start (car my-live-speech-recent-words))) 60.0))) (setq my-live-speech-wpm-string (my-live-speech-wpm-string))))))
Append to EmacsConf Etherpad
(defvar my-live-speech-etherpad-id nil) (defun my-live-speech-append-to-etherpad (recognition-results) (when my-live-speech-etherpad-id (emacsconf-pad-append-text my-live-speech-etherpad-id (concat " " (assoc-default 'transcript recognition-results)))))
UTF-8
From http://www.wisdomandwonder.com/wordpress/wp-content/uploads/2014/03/C3F.html
(prefer-coding-system 'utf-8) (when (display-graphic-p) (setq x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING)))
Wdiff
: I switched to using proper font-locking, yay.
This uses the wdiff tool for word-based diffs.
(defvar my-wdiff-mode-font-lock-keywords `(("{\\+\\(.*?\\)\\+}" . 'diff-added) ("\\[\\-\\(.*?\\)\\-\\]" . 'diff-removed))) (defconst my-wdiff-mode-font-lock-defaults '(my-wdiff-mode-font-lock-keywords t nil nil nil (font-lock-multiline . t))) (define-derived-mode my-wdiff-mode fundamental-mode "Word diff" "Highlight word diffs." (setq-local font-lock-defaults my-wdiff-mode-font-lock-defaults)) (defun my-wdiff (old-file new-file) (interactive (list (read-file-name "Original: ") (buffer-file-name))) (with-current-buffer (get-buffer-create "*wdiff*") (erase-buffer) (call-process "wdiff" nil t t (expand-file-name old-file) (expand-file-name new-file)) (goto-char (point-min)) (my-wdiff-mode) (switch-to-buffer (current-buffer)))) (defun my-wdiff-buffer-with-file () (interactive) (let ((s (buffer-string)) (temp-file (make-temp-file "temp"))) (with-temp-file temp-file (insert s)) (my-wdiff (buffer-file-name) temp-file) (delete-file temp-file)))
Org Mode org
I use Org Mode to take notes, publish my blog, and do all sorts of stuff.
(defvar my-org-inbox-file "~/sync/orgzly/Inbox.org") (use-package org :load-path ("~/vendor/org-mode/lisp" "~/vendor/org-mode/contrib/lisp") :bind (:map org-mode-map ("C-M-<return>" . org-insert-subheading)) :custom (org-export-with-sub-superscripts nil) (org-fold-catch-invisible-edits 'smart))
Insert a link to an Org Mode heading from an org-refile prompt org
I often want to link to an Org heading from somewhere in my org-refile-targets
, which includes my agenda files and other things. I don't want to think about where the heading is, I just want to link to it. I could use C-u C-c C-w
(org-refile
) to go to the heading, use C-c l
(my shortcut for org-store-link
), head back with org-mark-ring-goto
, and then insert it with C-c C-l
(org-insert-link
).
Or I can use this code to make an Embark command that hooks into minibuffer prompts that include "goto" or "refile", so I can link to something with C-. i
right from a refile or goto query.
(defun my-embark-org-insert-link-from-path (path) (interactive (list (car (org-refile-get-location)))) (let* ((extra (if org-refile-use-outline-path "/" "")) (tbl (mapcar (lambda (x) (if (and (not (member org-refile-use-outline-path '(file full-file-path title))) (not (equal filename (file-truename (nth 1 x))))) (cons (concat (car x) extra " (" (file-name-nondirectory (nth 1 x)) ")") (cdr x)) (cons (concat (car x) extra) (cdr x)))) org-refile-target-table)) link) (insert (save-window-excursion (save-excursion (org-goto-marker-or-bmk (elt (org-refile--get-location path tbl) 3)) (org-store-link nil)))))) (defvar-keymap my-org-path-map :doc "Shortcuts for working with Org paths from `org-refile'." "i" #'my-embark-org-insert-link-from-path "L" #'my-embark-org-insert-link-from-path) (with-eval-after-load 'marginalia (add-to-list 'marginalia-prompt-categories '("Goto\\|Refile" . my-org-path))) (with-eval-after-load 'embark (add-to-list 'embark-keymap-alist '(my-org-path . my-org-path-map)))
Let's make it work for org-heading
too, like what we get from M-x consult-org-heading
:
(with-eval-after-load 'consult-org (keymap-set embark-org-heading-map "L" #'embark-org-insert-link-to))
There are more Embark shortcuts in my Embark configuration.
Org - mapping blog posts and image URLs from bulk exports image
(defun my-org-map-blog-and-image-urls () "Extract and map blog post / image URLs." (interactive) (goto-char (point-min)) (keep-lines "h2\\|img") (goto-char (point-min)) (while (re-search-forward "^.*?h2.*?a href=\"\\(.*?\\)\".*$" nil t) (replace-match "\\1")) (goto-char (point-min)) (while (re-search-forward "^.*?src=\"\\(.*?\\)\".*$" nil t) (replace-match "\\1")) (let (last-post current-url result) (goto-char (point-min)) (while (re-search-forward "http://\\(.*\\)" nil t) (setq current-url (match-string 0)) (if (string-match "/\\([^/]*?\\)\\(_thumb\\|-640x.*\\)?.png" current-url) (setq result (cons (concat (match-string 1 current-url) "\t" last-post) result)) (setq last-post current-url))) (kill-new (mapconcat 'identity result "\n"))))
Move Org Mode properties from subtree to parent
Sometimes I set Org properties on a subtree when I meant to set them on the parent heading. This function moves all the properties up one level.
(defun my-org-move-properties-to-parent () (interactive) (let ((properties (org-entry-properties (point) 'standard))) ;; delete properties from the current entry (mapc (lambda (prop) (unless (string= (car prop) "CATEGORY") (org-entry-delete (point) (car prop)))) properties) ;; add properties (outline-up-heading 1) (mapc (lambda (prop) (org-entry-put (point) (car prop) (cdr prop))) properties)))
My files
Here are the Org files I use. I should probably organize them better. =)
organizer.org | My main Org file. Inbox for M-x org-capture, tasks, weekly reviews, etc. |
news.org | inbox for Emacs News |
business.org | Business-related notes and TODOs |
people.org | People-related tasks |
evil-plans/index.org | High-level goals |
sharing/index.org | Things to write about |
decisions.org | Pending, current, and reviewed decisions |
blog.org | Topic index for my blog |
learning.org | Learning plan |
outline.org | Huge outline of notes by category |
tracking.org | Temporary Org file for tracking various things |
delegation.org | Templates for assigning tasks - now using Google Docs instead |
books.org | Huge file with book notes |
calendar.org | Now using this with org-gcal |
ideal.org | Planning ideal days |
archive.org | Archived subtrees |
latin.org | Latin notes |
101things.org | Old goals for 101 things in 1001 days |
life.org | Questions, processes, tools |
sewing.org | Sewing projects, fabric tracking, etc. |
Modules
Org has a whole bunch of optional modules. These are the ones I'm currently experimenting with.
(setq org-modules '(org-habit org-mouse org-protocol org-annotate-file org-expiry org-interactive-query org-collector org-panel org-screen org-toc)) (eval-after-load 'org '(org-load-modules-maybe t)) ;; Prepare stuff for org-export-backends (setq org-export-backends '(org latex icalendar html ascii))
Keyboard shortcuts
(bind-key "C-c r" 'org-capture) (bind-key "C-c a" 'org-agenda) (bind-key "C-c l" 'org-store-link) (bind-key "C-c L" 'org-insert-link-global) (bind-key "C-c O" 'org-open-at-point-global)
append-next-kill
is more useful to me than org-table-copy-region
.
(with-eval-after-load 'org (bind-key "C-M-w" 'append-next-kill org-mode-map) (bind-key "C-TAB" 'org-cycle org-mode-map) (bind-key "C-c v" 'org-show-todo-tree org-mode-map) (bind-key "C-c C-r" 'org-refile org-mode-map) (bind-key "C-c R" 'org-reveal org-mode-map) (bind-key "C-c o" 'my-org-follow-entry-link org-mode-map) (bind-key "C-c d" 'my-org-move-line-to-destination org-mode-map) (bind-key "C-c t s" 'my-split-sentence-and-capitalize org-mode-map) (bind-key "C-c t -" 'my-split-sentence-delete-word-and-capitalize org-mode-map) (bind-key "C-c t d" 'my-delete-word-and-capitalize org-mode-map) (bind-key "C-c C-p C-p" 'my-org-publish-maybe org-mode-map) (bind-key "C-c C-r" 'my-org-refile-and-jump org-mode-map))
I don't use the diary, but I do use the clock a lot.
(with-eval-after-load 'org-agenda (bind-key "i" 'org-agenda-clock-in org-agenda-mode-map))
Speed commands
These are great for quickly acting on tasks.
- hello
- world
- this
- world here
(setq org-use-effective-time t) (defun my-org-use-speed-commands-for-headings-and-lists () "Activate speed commands on list items too." (or (and (looking-at org-outline-regexp) (looking-back "^\**" nil)) (save-excursion (and (looking-at (org-item-re)) (looking-back "^[ \t]*" nil))))) (setq org-use-speed-commands 'my-org-use-speed-commands-for-headings-and-lists) (defun my-org-subtree-text () (save-excursion (buffer-substring (save-excursion (org-end-of-meta-data t) (point)) (org-end-of-subtree)))) (defun my-org-mark-done () (interactive) (my-org-with-current-task (org-todo "DONE"))) (defun my-org-mark-done-and-add-to-journal (&optional note category) (interactive (list (if current-prefix-arg (read-string (format "Note (%s): " (org-get-heading t t t t))) (org-get-heading t t t t)) (or (org-entry-get (point) "JOURNAL_CAT") (my-journal-read-category (my-journal-guess-category))))) (my-org-with-current-task (org-todo "DONE") (org-entry-put (point) "JOURNAL_CAT" category) (let* ((title (or note (org-get-heading t t t t))) (zid (org-entry-get (point) "ZIDSTRING")) (other (if current-prefix-arg (substring-no-properties (my-org-subtree-text)))) (date (unless zid (format-time-string "%Y-%m-%d %H:%M" (let ((base-date (org-read-date nil t (org-entry-get (point) "CREATED")))) (if (string-match "Yesterday " title) (progn (setq title (replace-match "" nil nil title)) (org-read-date nil t "--1" nil (org-time-string-to-time (org-entry-get (point) "CREATED")))) base-date)))))) (if zid (my-journal-update (list :ZIDString zid :Note title :Category category :Other other)) (org-entry-put (point) "ZIDSTRING" (plist-get (my-journal-post title :Category category :Other other :Date date) :ZIDString))) (org-back-to-heading) (my-copy-observation)))) (with-eval-after-load 'org (let ((listvar (if (boundp 'org-speed-commands) 'org-speed-commands 'org-speed-commands-user))) (add-to-list listvar '("A" org-archive-subtree-default)) (add-to-list listvar '("x" org-todo "DONE")) (add-to-list listvar '("X" call-interactively 'my-org-mark-done-and-add-to-journal)) (add-to-list listvar '("y" org-todo-yesterday "DONE")) (add-to-list listvar '("!" my-org-clock-in-and-track)) (add-to-list listvar '("s" call-interactively 'org-schedule)) (add-to-list listvar '("d" my-org-move-line-to-destination)) (add-to-list listvar '("i" call-interactively 'org-clock-in)) (add-to-list listvar '("o" call-interactively 'org-clock-out)) (add-to-list listvar '("$" call-interactively 'org-archive-subtree))) (bind-key "!" 'my-org-clock-in-and-track org-agenda-mode-map))
Taking notes
(setq org-directory "~/sync/orgzly/") (setq org-default-notes-file "~/sync/orgzly/organizer.org")
Date trees
This quickly adds a same-level heading for the succeeding day.
(defun my-org-insert-heading-for-next-day () "Insert a same-level heading for the following day." (interactive) (let ((new-date (seconds-to-time (+ 86400.0 (float-time (org-read-date nil 'to-time (elt (org-heading-components) 4))))))) (org-insert-heading-after-current) (insert (format-time-string "%Y-%m-%d\n\n" new-date))))
Templates
I use org-capture
templates to quickly jot down tasks, ledger
entries, notes, and other semi-structured pieces of information.
(defun my-org-contacts-template-email (&optional return-value) "Try to return the contact email for a template. If not found return RETURN-VALUE or something that would ask the user." (eval-when-compile (require 'gnus-art nil t)) (eval-when-compile (require 'org-contacts nil t)) (or (cadr (if (gnus-alive-p) (gnus-with-article-headers (mail-extract-address-components (or (mail-fetch-field "Reply-To") (mail-fetch-field "From") ""))))) return-value (concat "%^{" org-contacts-email-property "}p"))) (defvar my-org-basic-task-template "* TODO %^{Task} :PROPERTIES: :Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00} :END: Captured %<%Y-%m-%d %H:%M> %? %i " "Basic task data") (defvar my-ledger-file "~/cloud/ledger/current.ledger") (with-eval-after-load 'org-capture (setq org-capture-templates (seq-uniq (append `(("r" "Note" entry (file ,my-org-inbox-file) "* %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n%i\n\n- %a" :prepend t) ("t" "Task with annotation" entry (file ,my-org-inbox-file) "* TODO %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n%a\n" :prepend t) ("i" "Interrupting task" entry (file ,my-org-inbox-file) "* STARTED %^{Task}\n:PROPERTIES:\n:CREATED: %U\n:END:\n%a\n" :clock-in :clock-resume :prepend t) ("T" "Task without annotation" entry (file ,my-org-inbox-file) "* TODO %^{Task}\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n" :prepend t) ;; From https://takeonrules.com/2022/10/16/adding-another-function-to-my-workflow/ ("c" "Contents to current clocked task" plain (clock) "%i%?" :empty-lines 1) ;; ("p" "Podcast log - timestamped" item ;; (file+olp+datetree "~/sync/orgzly/timestamped.org") ;; "%<%H:%M:%S,%3N> %^{Note}" ;; :immediate-finish t) ;; ("b" "Plover note" table-line ;; (file+headline "~/proj/plover-notes/README.org" "Brief notes") ;; "| %^{Stroke} | %^{Translation} | %^{Note} |" ;; :immediate-finish t) ;; ("c" "Plover review from clippy" table-line ;; (file+headline "~/proj/plover-notes/README.org" "For review") ;; "%(let ((last (my-clippy-last))) (format \"| %s | %s |\" (car last) (cdr last)))" ;; :immediate-finish t) ("." "Today" entry (file ,my-org-inbox-file) "* TODO %^{Task}\nSCHEDULED: %t\n:PROPERTIES:\n:CREATED: %U\n:END:\n" :immediate-finish t) ("v" "Video" entry (file ,my-org-inbox-file) "* TODO %^{Task} :video:\nSCHEDULED: %t\n" :immediate-finish t) ("e" "Errand" entry (file ,my-org-inbox-file) "* TODO %^{Task} :errands:\n:PROPERTIES:\n:CREATED: %U\n:END:\n" :immediate-finish t) ("n" "Note" entry (file ,my-org-inbox-file) "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n" :immediate-finish t) ("N" "Note" entry (file ,my-org-inbox-file) "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n" :prepend t) ("s" "Screenshot" entry (file ,my-org-inbox-file) "* %^{Note}\n:PROPERTIES:\n:CREATED: %U\n:END:\n\n[[file:%(my-latest-file my-screenshot-directory)]]\n" :prepend t) ("b" "Business task" entry (file+headline "~/personal/business.org" "Tasks") ,my-org-basic-task-template) ("j" "Journal entry" plain (file+olp+datetree "~/sync/orgzly/journal.org") "%K - %a\n%i\n%?\n" :unnarrowed t) ("db" "Done - Business" entry (file+headline "~/personal/business.org" "Tasks") "* DONE %^{Task}\nSCHEDULED: %^t\n%?") ("dp" "Done - People" entry (file+headline "~/personal/people.org" "Tasks") "* DONE %^{Task}\nSCHEDULED: %^t\n%?") ("dt" "Done - Task" entry (file+headline "~/sync/orgzly/organizer.org" "Inbox") "* DONE %^{Task}\nSCHEDULED: %^t\n%?") ("q" "Quick note" item (file+headline "~/sync/orgzly/organizer.org" "Quick notes")) ("l" "Ledger") ("lc" "Cash expense" plain (file ,my-ledger-file) "%(ledger-read-date \"Date: \") * %^{Payee} Expenses:Cash Expenses:%^{Account} %^{Amount} ") ("lb" "BDO CAD" plain (file ,my-ledger-file) "%(ledger-read-date \"Date: \") * %^{Payee} Expenses:Play $ %^{Amount} Assets:BDO ") ("lp" "BDO PHP" plain (file ,my-ledger-file) "%(ledger-read-date \"Date: \") * %^{Payee} Expenses:Play PHP %^{Amount} Assets:BDO ") ("B" "Book" entry (file+datetree "~/personal/books.org" "Inbox") "* %^{Title} %^g %i *Author(s):* %^{Author} \\\\ *ISBN:* %^{ISBN} %? *Review on:* %^t \\ %a %U" :clock-in :clock-resume) ("C" "Contact" entry (file "~/sync/orgzly/people.org") "* %(org-contacts-template-name) :PROPERTIES: :EMAIL: %(my-org-contacts-template-email) :END:") ("y" "Yay Emacs" entry (file+headline "~/proj/stream/index.org" "Notes for this session") "* %?\n:PROPERTIES:\n:CREATED: %U\n:END:\n %i %a ")) org-capture-templates)))) (bind-key "C-M-r" 'org-capture) ;;(bind-key (kbd "<f5>") 'org-capture)
Allow refiling in the middle(ish) of a capture
This lets me use C-c C-r
to refile a capture and then jump to the
new location. I wanted to be able to file tasks under projects so that
they could inherit the QUANTIFIED property that I use to track time
(and any Beeminder-related properties too), but I also wanted to be
able to clock in on them.
(defun my-org-refile-and-jump () (interactive) (if (derived-mode-p 'org-capture-mode) (org-capture-refile) (call-interactively 'org-refile)) (org-refile-goto-last-stored)) (eval-after-load 'org-capture '(bind-key "C-c C-r" 'my-org-refile-and-jump org-capture-mode-map))
Try out this capture command
From https://takeonrules.com/2022/10/16/adding-another-function-to-my-workflow/
(use-package git-link) (bind-key "C-c c" 'jf/capture-region-contents-with-metadata) (defun jf/capture-region-contents-with-metadata (start end parg) "Write selected text between START and END to currently clocked `org-mode' entry. With PARG kill the content instead." (interactive "r\nP") (let ((text (jf/region-contents-get-with-metadata start end))) (if (car parg) (kill-new text) (org-capture-string (concat "-----\n" text) "c")))) (defun jf/region-contents-get-with-metadata (start end) "Get the region contents between START and END and return an `org-mode' formatted string." (require 'magit) (require 'git-link) (let* ((file-name (buffer-file-name (current-buffer))) (org-src-mode (replace-regexp-in-string "-mode" "" (format "%s" major-mode))) (func-name (which-function)) (type (if (derived-mode-p 'prog-mode) "SRC" "EXAMPLE")) (code-snippet (buffer-substring-no-properties start end)) (file-base (file-name-nondirectory file-name)) (line-number (line-number-at-pos (region-beginning))) (remote-link (when (magit-list-remotes) (progn (call-interactively 'git-link) (car kill-ring)))) (initial-txt (if (null func-name) (format "From [[file:%s::%s][%s]]:" file-name line-number file-base) (format "From ~%s~ (in [[file:%s::%s][%s]]):" func-name file-name line-number file-base)))) (format (concat "\n- Local :: %s" (when remote-link (format "\n- Remote :: %s" remote-link)) "\n\n#+BEGIN_%s %s" "\n%s" "\n#+END_%s\n") initial-txt type org-src-mode code-snippet type)))
Estimating WPM
I'm curious about how fast I type some things.
(require 'org-clock) (defun my-org-entry-wpm () (interactive) (save-restriction (save-excursion (org-narrow-to-subtree) (goto-char (point-min)) (let* ((words (count-words-region (point-min) (point-max))) (minutes (org-clock-sum-current-item)) (wpm (/ words minutes))) (message "WPM: %d (words: %d, minutes: %d)" wpm words minutes) (kill-new (number-to-string wpm))))))
Logbook
(defun my-org-log-note (note) "Add NOTE to the current entry's logbook." (interactive "MNote: ") (setq org-log-note-window-configuration (current-window-configuration)) (move-marker org-log-note-return-to (point)) (move-marker org-log-note-marker (point)) (setq org-log-note-purpose 'note) (with-temp-buffer (insert note) (org-store-log-note)))
Tasks
Managing tasks
Get things to be set to TODO when they repeat
I use STARTED
to keep track of things I've started working on, and this is updated when I clock into the task. If I have a repeating task, I want the task to be automatically reset to TODO
.
(setq org-todo-repeat-to-state "TODO")
Track TODO state
The parentheses indicate keyboard shortcuts that I can use to set the
task state. @
and !
toggle logging. @
prompts you for a note,
and !
automatically logs the timestamp of the state change.
(setq org-todo-keywords '((sequence "STARTED(s)" "TODO(t)" ; next action "TOBLOG(b)" "WAITING(w@/!)" "READY(r)" "SOMEDAY(.)" "BLOCKED(k@/!)" "|" "DONE(x!)" "CANCELLED(c)") (sequence "PROJECT" "|" "DONE(x)") (sequence "LEARN" "TRY" "TEACH" "|" "COMPLETE(x)") (sequence "TOSKETCH" "SKETCHED" "|" "POSTED") (sequence "TOBUY" "TOSHRINK" "TOCUT" "TOSEW" "|" "DONE(x)") (sequence "TODELEGATE(-)" "DELEGATED(d)" "|" "COMPLETE(x)")))
(setq org-log-done 'time)
TODO Change Org Mode TODO keyword color based on the state and the current Modus theme
I use modus-theme-toggle
to switch between
modus-vivendi-tinted
and modus-operandi-tinted
depending on whether I want a dark background or a
light one. I also customize my
org-todo-keyword-faces
to visually distinguish
TODO, DONE, WAITING, and SOMEDAY. This is how to
colour them based on the current Modus theme.
(defun my-org-todo-set-keyword-faces () (setq org-todo-keyword-faces `(("TODO" . (:foreground ,(modus-themes-get-color-value 'blue-warmer) :weight bold)) ("DONE" . (:foreground ,(modus-themes-get-color-value 'green-warmer) :weight bold)) ("WAITING" . (:foreground ,(modus-themes-get-color-value 'red-warmer) :weight bold)) ("SOMEDAY" . (:foreground ,(modus-themes-get-color-value 'fg-dim) :weight bold)))) (when (derived-mode-p 'org-mode) (font-lock-fontify-buffer))) (with-eval-after-load 'modus-themes (add-hook 'modus-themes-after-load-theme-hook #'my-org-todo-set-keyword-faces))
Projects
Projects are headings with the :project:
tag, so we generally don't
want that tag inherited, except when we display unscheduled tasks that
don't belong to any projects.
(setq org-tags-exclude-from-inheritance '("project" "inboxtarget"))
This code makes it easy for me to focus on one project and its tasks.
(with-eval-after-load 'org (let ((listvar (if (boundp 'org-speed-commands) 'org-speed-commands 'org-speed-commands-user))) (add-to-list listvar '("N" org-narrow-to-subtree)) (add-to-list listvar '("W" widen)) (add-to-list listvar '("T" my-org-agenda-for-subtree)) (add-to-list listvar '("b" my-org-bounce-to-file)))) (defun my-org-agenda-for-subtree () (interactive) (when (derived-mode-p 'org-agenda-mode) (org-agenda-switch-to)) (my-org-with-current-task (let ((org-agenda-view-columns-initially t)) (org-agenda nil "t" 'subtree))))
There's probably a proper way to do this, maybe with <
. Oh, that would work nicely. < C-c a t
too.
And sorting:
(with-eval-after-load 'org (let ((listvar (if (boundp 'org-speed-commands) 'org-speed-commands 'org-speed-commands-user))) (add-to-list listvar '("S" call-interactively 'org-sort))))
Tag tasks with GTD-ish contexts
This defines keyboard shortcuts for those, too.
(setq org-tag-alist '(("work" . ?b) ("home" . ?h) ("writing" . ?w) ("errands" . ?e) ("drawing" . ?d) ("coding" . ?c) ("video" . ?v) ("kaizen" . ?k) ("phone" . ?p) ("learning" . ?a) ("reading" . ?r) ("computer" . ?l) ("quantified" . ?q) ("shopping" .?s) ("focus" . ?f)))
Enable filtering by effort estimates
That way, it's easy to see short tasks that I can finish.
(add-to-list 'org-global-properties '("Effort_ALL". "0:05 0:15 0:30 1:00 2:00 3:00 4:00"))
Track time
(use-package org :init (progn (setq org-expiry-inactive-timestamps t) (setq org-clock-idle-time nil) (setq org-log-done 'time) (setq org-clock-auto-clock-resolution nil) (setq org-clock-continuously nil) (setq org-clock-persist t) (setq org-clock-in-switch-to-state "STARTED") (setq org-clock-in-resume nil) (setq org-show-notification-handler 'message) (setq org-clock-report-include-clocking-task t)) :config (org-clock-persistence-insinuate))
Too many clock entries clutter up a heading.
(setq org-log-into-drawer "LOGBOOK") (setq org-clock-into-drawer 1)
Habits
I like using org-habits to track consistency. My task names tend to be a bit long, though, so I've configured the graph column to show a little bit more to the right.
(setq org-habit-graph-column 80) (setq org-habit-show-habits-only-for-today nil)
If you want to use habits, be sure to schedule your tasks and add a STYLE property with the value of habit
to the tasks you want displayed.
Estimating tasks
From "Add an effort estimate on the fly when clocking in" on the Org Hacks page:
(add-hook 'org-clock-in-prepare-hook 'my-org-mode-ask-effort) (defun my-org-mode-ask-effort () "Ask for an effort estimate when clocking in." (unless (org-entry-get (point) "Effort") (let ((effort (completing-read "Effort: " (org-entry-get-multivalued-property (point) "Effort")))) (unless (equal effort "") (org-set-property "Effort" effort)))))
Flexible scheduling of tasks
I (theoretically) want to be able to schedule tasks for dates like the first Saturday of every month. Fortunately, someone else has figured that out!
;; Get this from https://raw.github.com/chenfengyuan/elisp/master/next-spec-day.el (load "~/elisp/next-spec-day.el" t)
Task dependencies
(setq org-enforce-todo-dependencies t) (setq org-track-ordered-property-with-tag t) (setq org-agenda-dim-blocked-tasks t)
Quick way to archive all DONE from inbox emacs computer
(defun my-org-clean-up-inbox () "Archive all DONE tasks and sort the remainder by TODO order." (interactive) (with-current-buffer (find-file my-org-inbox-file) (my-org-archive-done-tasks 'file) (goto-char (point-min)) (if (org-at-heading-p) (save-excursion (insert "\n"))) (org-sort-entries nil ?p) (goto-char (point-min)) (org-sort-entries nil ?o) (save-buffer))) (defun my-org-archive-done-tasks (&optional scope) "Archive finished or cancelled tasks. SCOPE can be 'file or 'tree." (interactive) (org-map-entries (lambda () (org-archive-subtree) (setq org-map-continue-from (outline-previous-heading))) "TODO=\"DONE\"|TODO=\"CANCELLED\"" (or scope (if (org-before-first-heading-p) 'file 'tree))))
Strike through DONE headlines
I wanted a quick way to visually distinguish DONE tasks from tasks I still need to do. This handy snippet from the Emacs Org-mode mailing list does the trick by striking through the headlines for DONE tasks.
(setq org-fontify-done-headline t) (custom-set-faces '(org-done ((t (:foreground "PaleGreen" :weight normal :strike-through t)))) '(org-headline-done ((((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon" :strike-through t)))))
Templates
Structure templates
Org makes it easy to insert blocks by typing <s[TAB]
, etc.
I hardly ever use LaTeX, but I insert a lot of Emacs Lisp blocks, so I
redefine <l
to insert a Lisp block instead.
(setq org-structure-template-alist '(("a" . "export ascii") ("C" . "center") ("c" . "comment") ("d" . "my_details") ("e" . "example") ("E" . "export") ("m" . "export md") ("h" . "export html") ("j" . "src js :spookfox t") ("l" . "src emacs-lisp") ("p" . "src python") ("n" . "notes") ("q" . "quote") ("s" . "src") ("S" . "src sh") ("u" . "update") ("v" . "verse")))
This lets me nest quotes. http://emacs.stackexchange.com/questions/2404/exporting-org-mode-nested-blocks-to-html
(defun my-org-html-quote2 (block backend info) (when (org-export-derived-backend-p backend 'html) (when (string-match "\\`<div class=\"quote2\">" block) (setq block (replace-match "<blockquote>" t nil block)) (string-match "</div>\n\\'" block) (setq block (replace-match "</blockquote>\n" t nil block)) block))) (eval-after-load 'ox '(add-to-list 'org-export-filter-special-block-functions 'my-org-html-quote2))
Demarcate, but for all blocks emacs config
I often want to split an Org Mode block so that I can add stuff in between. This code is based on https://scripter.co/splitting-an-org-block-into-two/ .
(defun modi/org-split-block () "Sensibly split the current Org block at point." (interactive) (if (modi/org-in-any-block-p) (save-match-data (save-restriction (widen) (let ((case-fold-search t) (at-bol (bolp)) block-start block-end) (save-excursion (re-search-backward "^\\(?1:[[:blank:]]*#\\+begin_.+?\\)\\(?: .*\\)*$" nil nil 1) (setq block-start (match-string-no-properties 0)) (setq block-end (replace-regexp-in-string "begin_" "end_" ;Replaces "begin_" with "end_", "BEGIN_" with "END_" (match-string-no-properties 1)))) ;; Go to the end of current line, if not at the BOL (unless at-bol (end-of-line 1)) (insert (concat (if at-bol "" "\n") block-end "\n\n" block-start (if at-bol "\n" ""))) ;; Go to the line before the inserted "#+begin_ .." line (beginning-of-line (if at-bol -1 0))))) (message "Point is not in an Org block"))) (defalias 'my-org-demarcate-block #'modi/org-split-block) (defalias 'my-org-split-block #'modi/org-split-block) (defun modi/org-in-any-block-p () "Return non-nil if the point is in any Org block. The Org block can be *any*: src, example, verse, etc., even any Org Special block. This function is heavily adapted from `org-between-regexps-p'." (save-match-data (let ((pos (point)) (case-fold-search t) (block-begin-re "^[[:blank:]]*#\\+begin_\\(?1:.+?\\)\\(?: .*\\)*$") (limit-up (save-excursion (outline-previous-heading))) (limit-down (save-excursion (outline-next-heading))) beg end) (save-excursion ;; Point is on a block when on BLOCK-BEGIN-RE or if ;; BLOCK-BEGIN-RE can be found before it... (and (or (org-in-regexp block-begin-re) (re-search-backward block-begin-re limit-up :noerror)) (setq beg (match-beginning 0)) ;; ... and BLOCK-END-RE after it... (let ((block-end-re (concat "^[[:blank:]]*#\\+end_" (match-string-no-properties 1) "\\( .*\\)*$"))) (goto-char (match-end 0)) (re-search-forward block-end-re limit-down :noerror)) (> (setq end (match-end 0)) pos) ;; ... without another BLOCK-BEGIN-RE in-between. (goto-char (match-beginning 0)) (not (re-search-backward block-begin-re (1+ beg) :noerror)) ;; Return value. (cons beg end))))))
Emacs chats, Emacs hangouts
(defun my-org-link-youtube-time (url beg end) "Link times of the form h:mm to YouTube video at URL. Works on region defined by BEG and END." (interactive (list (read-string "URL: " (org-entry-get-with-inheritance "YOUTUBE")) (point) (mark))) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (let ((char (if (string-match "\\?" url) "&" "?"))) (while (re-search-forward "\\(\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\) ::" nil t) (replace-match (format "[[%s%st=%sh%sm%ss][%s]] " url char (match-string 2) (match-string 3) (or (match-string 5) "0") (match-string 1)) nil t)))))) (defun my-clean-up-google-hangout-chat () (interactive) (save-excursion (while (re-search-forward "<hr.*?div class=\"Kc-Ma-m\".*?>" nil t) (replace-match "\n| "))) (save-excursion (while (re-search-forward "</div><div class=\"Kc-yi-m\">" nil t) (replace-match " | "))) (save-excursion (while (re-search-forward "</div></div><div class=\"Kc-ib\">" nil t) (replace-match " | "))) (save-excursion (while (re-search-forward "<a rel=\"nofollow\" target=\"_blank\" href=\"\\(.*?\\)\">\\(.*?\\)</a>" nil t) (replace-match "[[\\1][\\2]]"))) (save-excursion (while (re-search-forward "</div></div></div></div>" nil t) (replace-match " |"))) (save-excursion (while (re-search-forward " " nil t) (replace-match " "))) (save-excursion (while (re-search-forward "</div><div class=\"Kc-ib\">" nil t) (replace-match " "))) (save-excursion (while (re-search-forward "<img.*?>" nil t) (replace-match ""))) (save-excursion (while (re-search-forward "<wbr>" nil t) (replace-match ""))) )
Org agenda
Basic configuration
I have quite a few Org files, but I keep my agenda items and TODOs in only a few of them them for faster scanning.
(defvar my-kid-org-file nil "Defined in secrets") (setq org-agenda-files (delq nil (mapcar (lambda (x) (and x (file-exists-p x) x)) `("~/sync/orgzly/organizer.org" "~/sync/orgzly/Inbox.org" "~/sync/orgzly/garden.org" "~/sync/orgzly/decisions.org" "~/sync/orgzly/computer-inbox.org" "~/sync/orgzly/posts.org" "~/sync/orgzly/crafts.org" "~/sync/emacs/Sacha.org" "~/proj/stream/index.org" "~/proj/plover-notes/README.org" "~/personal/sewing.org" "~/sync/orgzly/people.org" "~/sync/orgzly/business.org" "~/Dropbox/wsmef/trip.txt" ,my-kid-org-file "~/personal/orgzly.org" "~/personal/calendar.org" "~/Dropbox/tasker/summary.txt" "~/Dropbox/public/sharing/index.org" "~/dropbox/public/sharing/learning.org" "~/proj/emacs-notes/tasks.org" "~/proj/sachac.github.io/evil-plans/index.org" "~/sync/orgzly/cooking.org" "~/sync/orgzly/routines.org")))) (setq org-agenda-dim-blocked-tasks nil) (add-to-list 'auto-mode-alist '("\\.txt$" . org-mode))
I like looking at two days at a time when I plan using the Org agenda. I want to see my log entries, but I don't want to see scheduled items that I've finished. I like seeing a time grid so that I can get a sense of how appointments are spread out.
(setq org-agenda-span 2) (setq org-agenda-tags-column -100) ; take advantage of the screen width (setq org-agenda-sticky nil) (setq org-agenda-inhibit-startup t) (setq org-agenda-use-tag-inheritance t) (setq org-agenda-show-log t) (setq org-agenda-skip-scheduled-if-done t) (setq org-agenda-skip-deadline-if-done t) (setq org-agenda-skip-deadline-prewarning-if-scheduled 'pre-scheduled) (setq org-agenda-time-grid '((daily today require-timed) (800 1000 1200 1400 1600 1800 2000) "......" "----------------")) (setq org-columns-default-format "%14SCHEDULED %Effort{:} %1PRIORITY %TODO %50ITEM %TAGS")
Some other keyboard shortcuts:
(bind-key "Y" 'org-agenda-todo-yesterday org-agenda-mode-map)
Starting my weeks on Saturday
I like looking at weekends as week beginnings instead, so I want the Org agenda to start on Saturdays.
(setq org-agenda-start-on-weekday 6)
Display projects with associated subtasks
I wanted a view that showed projects with a few subtasks underneath them. Here's a sample of the output:
Headlines with TAGS match: +PROJECT Press `C-u r' to search again with new search string organizer: Set up communication processes for Awesome Foundation Toronto organizer: TODO Announce the next pitch night organizer: TODO Follow up with the winner of the previous pitch night for any news to include in the updates organizer: Tidy up the house so that I can find things quickly organizer: TODO Inventory all the things in closets and boxes :@home: organizer: TODO Drop things off for donation :@errands: organizer: Learn how to develop for Android devices
(defun my-org-agenda-project-agenda () "Return the project headline and up to `org-agenda-max-entries' tasks." (save-excursion (let* ((marker (org-agenda-new-marker)) (heading (org-agenda-format-item "" (org-get-heading) (org-get-category) nil)) (org-agenda-restrict t) (org-agenda-restrict-begin (point)) (org-agenda-restrict-end (org-end-of-subtree 'invisible)) ;; Find the TODO items in this subtree (list (org-agenda-get-day-entries (buffer-file-name) (calendar-current-date) :todo))) (org-add-props heading (list 'face 'defaults 'done-face 'org-agenda-done 'undone-face 'default 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name (or (buffer-file-name (buffer-base-buffer)) (buffer-name (buffer-base-buffer)))))) 'org-marker marker 'org-hd-marker marker 'org-category (org-get-category) 'type "tagsmatch") (concat heading "\n" (org-agenda-finalize-entries list))))) (defun my-org-agenda-projects-and-tasks (match) "Show TODOs for all `org-agenda-files' headlines matching MATCH." (interactive "MString: ") (let ((todo-only nil)) (if org-agenda-overriding-arguments (setq todo-only (car org-agenda-overriding-arguments) match (nth 1 org-agenda-overriding-arguments))) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) rtn rtnall files file pos matcher buffer) (when (and (stringp match) (not (string-match "\\S-" match))) (setq match nil)) (when match (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher))) (catch 'exit (if org-agenda-sticky (setq org-agenda-buffer-name (if (stringp match) (format "*Org Agenda(%s:%s)*" (or org-keys (or (and todo-only "M") "m")) match) (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) (org-agenda-prepare (concat "TAGS " match)) (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) (setq org-agenda-redo-command (list 'org-tags-view `(quote ,todo-only) (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) (setq files (org-agenda-files nil 'ifmode) rtnall nil) (while (setq file (pop files)) (catch 'nextfile (org-check-agenda-file file) (setq buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) (error "No such file %s" file))) (if (not buffer) ;; If file does not exist, error message to agenda (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) rtnall (append rtnall rtn)) (with-current-buffer buffer (unless (derived-mode-p 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (save-excursion (save-restriction (if org-agenda-restrict (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end) (widen)) (setq rtn (org-scan-tags 'my-org-agenda-project-agenda matcher todo-only)) (setq rtnall (append rtnall rtn)))))))) (if org-agenda-overriding-header (insert (org-add-props (copy-sequence org-agenda-overriding-header) nil 'face 'org-agenda-structure) "\n") (insert "Headlines with TAGS match: ") (add-text-properties (point-min) (1- (point)) (list 'face 'org-agenda-structure 'short-heading (concat "Match: " match))) (setq pos (point)) (insert match "\n") (add-text-properties pos (1- (point)) (list 'face 'org-warning)) (setq pos (point)) (unless org-agenda-multi (insert "Press `C-u r' to search again with new search string\n")) (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) (when rtnall (insert (mapconcat 'identity rtnall "\n") "")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) `(org-agenda-type tags org-last-args (,todo-only ,match) org-redo-cmd ,org-agenda-redo-command org-series-cmd ,org-cmd)) (org-agenda-finalize) (setq buffer-read-only t)))))
Org agenda custom commands
There are quite a few custom commands here, and I often forget to use them. =) But it's good to define them, and over time, I'll get the hang of using these more!
Key | Description |
. | What am I waiting for? |
T | Not really an agenda command - shows the to-do tree in the current file |
b | Shows business-related tasks |
o | Shows personal tasks and miscellaneous tasks (o: organizer) |
w | Show all tasks for the upcoming week |
W | Show all tasks for the upcoming week, aside from the routine ones |
g … | Show tasks by context: b - business; c - coding; w - writing; p - phone; d - drawing, h - home |
0 | Show common contexts with up to 3 tasks each, so that I can choose what I feel like working on |
) (shift-0) | Show common contexts with all the tasks associated with them |
9 | Show common contexts with up to 3 unscheduled tasks each |
( (shift-9) | Show common contexts with all the unscheduled tasks associated with them |
d | Timeline for today (agenda, clock summary) |
u | Unscheduled tasks to do if I have free time |
U | Unscheduled tasks that are not part of projects |
P | Tasks by priority |
p | My projects |
2 | Projects with tasks |
(bind-key "<apps> a" 'org-agenda) (defvar my-org-agenda-contexts '((tags-todo "phone") (tags-todo "work") (tags-todo "drawing") (tags-todo "coding") (tags-todo "writing") (tags-todo "computer") (tags-todo "home") (tags-todo "errands")) "Usual list of contexts.") (defun my-org-agenda-skip-scheduled () (org-agenda-skip-entry-if 'scheduled 'deadline 'regexp "\n]+>")) (use-package org-super-agenda :init (org-super-agenda-mode 1)) (use-package org-ql) (defun my-org-projects () (interactive) (org-ql-search (org-agenda-files) '(and (todo "TODO" "WAITING") (ancestors (tags "project"))) :super-groups '((:auto-parent t)))) (setq org-agenda-custom-commands `(("a" "Agenda" ((agenda "" ((org-agenda-span 2))) ;; (alltodo ;; "" ;; ((org-agenda-overriding-header "") ;; (org-super-agenda-groups ;; '((:name "Inbox, unscheduled" ;; :and (:scheduled nil ;; :file-path "Inbox.org" ;; ) ;; :order 1) ;; (:name "Important, unscheduled" ;; :and (:priority "A" ;; :scheduled nil) ;; :order 2) ;; (:name "Project-related, unscheduled" ;; :and (:tag "project" :date nil :todo ("STARTED" "WAITING" "TODO")) ;; :order 3) ;; (:name "Waiting" ;; :and (:todo "WAITING" ;; :scheduled nil) ;; :order 4) ;; (:discard (:todo "SOMEDAY" ;; :category "cooking" ;; :date t)) ;; (:name "Unscheduled" ;; :scheduled nil ;; :order 5) ;; (:discard (:anything t)) ;; ) ;; ))) ;; (tags-todo "TODO=\"TODO\"-project-cooking-routine-errands-shopping-video-evilplans" ;; ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) ;; (org-agenda-prefix-format "%-6e ") ;; (org-agenda-overriding-header "Unscheduled TODO entries: ") ;; (org-agenda-sorting-strategy '(priority-down effort-up tag-up category-keep)))) )) ("e" "Emacs" tags "emacs") ("n" "Emacs News" tags "news" ((org-agenda-files '("~/sync/orgzly/Inbox.org" "~/sync/orgzly/news.org")))) ("E" "Emacsconf" tags-todo "emacsconf" ((org-agenda-sorting-strategy '(priority-down effort-up category-keep))) ) ("i" "Inbox" alltodo "" ((org-agenda-files '("~/sync/orgzly/Inbox.org" "~/sync/orgzly/computer-inbox.org")))) ("t" tags-todo "-cooking" ((org-agenda-sorting-strategy '(todo-state-up priority-down effort-up)))) ("T" tags-todo "TODO=\"TODO\"-goal-routine-cooking-SCHEDULED={.+}" nil "~/cloud/agenda/nonroutine.html") ("f" tags-todo "focus-TODO=\"DONE\"-TODO=\"CANCELLED\"") ("b" todo "" ((org-agenda-files '("~/sync/orgzly/business.org")))) ("B" todo "" ((org-agenda-files '("~/Dropbox/books")))) ("x" "Column view" todo "" ; Column view ((org-agenda-prefix-format "") (org-agenda-cmp-user-defined 'my-org-sort-agenda-items-todo) (org-agenda-view-columns-initially t) )) ;; Weekly review ("w" "Weekly review" agenda "" ((org-agenda-span 7) (org-agenda-log-mode 1)) "~/cloud/agenda/this-week.html") ("W" "Weekly review sans routines" agenda "" ((org-agenda-span 7) (org-agenda-log-mode 1) (org-agenda-tag-filter-preset '("-routine"))) "~/cloud/agenda/this-week-nonroutine.html") ("2" "Bi-weekly review" agenda "" ((org-agenda-span 14) (org-agenda-log-mode 1))) ("5" "Quick tasks" tags-todo "EFFORT>=\"0:05\"&EFFORT<=\"0:15\"") ("0" "Unestimated tasks" tags-todo "EFFORT=\"\"") ("gb" "Business" todo "" ((org-agenda-files '("~/sync/orgzly/business.org")) (org-agenda-view-columns-initially t))) ("gc" "Coding" tags-todo "@coding" ((org-agenda-view-columns-initially t))) ("gw" "Writing" tags-todo "@writing" ((org-agenda-view-columns-initially t))) ("gp" "Phone" tags-todo "@phone" ((org-agenda-view-columns-initially t))) ("gd" "Drawing" tags-todo "@drawing" ((org-agenda-view-columns-initially t))) ("gh" "Home" tags-todo "@home" ((org-agenda-view-columns-initially t))) ("gk" "Kaizen" tags-todo "kaizen" ((org-agenda-view-columns-initially t)) ("~/cloud/agenda/kaizen.html")) ("ge" "Errands" tags-todo "errands" ((org-agenda-view-columns-initially t)) ("~/cloud/agenda/errands.html")) ("c" "Top 3 by context" ,my-org-agenda-contexts ((org-agenda-sorting-strategy '(priority-up effort-down)) (org-agenda-max-entries 3))) ("C" "All by context" ,my-org-agenda-contexts ((org-agenda-sorting-strategy '(priority-down effort-down)) (org-agenda-max-entries nil))) ("9" "Unscheduled top 3 by context" ,my-org-agenda-contexts ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) (org-agenda-sorting-strategy '(priority-down effort-down)) (org-agenda-max-entries 3))) ("(" "All unscheduled by context" ,my-org-agenda-contexts ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) (org-agenda-sorting-strategy '(priority-down effort-down)) )) ("d" "Timeline for today" ((agenda "" )) ((org-agenda-ndays 1) (org-agenda-show-log t) (org-agenda-log-mode-items '(clock closed)) (org-agenda-clockreport-mode t) (org-agenda-entry-types '()))) ("." "Waiting for" todo "WAITING") ("u" "Unscheduled tasks" tags-todo "-someday-TODO=\"SOMEDAY\"-TODO=\"DELEGATED\"-TODO=\"WAITING\"-project-cooking-routine" ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) (org-agenda-view-columns-initially nil) (org-tags-exclude-from-inheritance '("project")) (org-agenda-overriding-header "Unscheduled TODO entries: ") (org-columns-default-format "%50ITEM %TODO %3PRIORITY %Effort{:} %TAGS") (org-agenda-sorting-strategy '(todo-state-up priority-down effort-up tag-up category-keep)))) ("!" "Someday" tags-todo "TODO=\"SOMEDAY\"" ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) (org-agenda-view-columns-initially nil) (org-tags-exclude-from-inheritance '("project")) (org-agenda-overriding-header "Someday: ") (org-columns-default-format "%50ITEM %TODO %3PRIORITY %Effort{:} %TAGS") (org-agenda-sorting-strategy '(todo-state-up priority-down effort-up tag-up category-keep)))) ("U" "Unscheduled tasks outside projects" tags-todo "-project-cooking-routine" ((org-agenda-skip-function 'my-org-agenda-skip-scheduled) (org-tags-exclude-from-inheritance nil) (org-agenda-view-columns-initially nil) (org-agenda-overriding-header "Unscheduled TODO entries outside projects: ") (org-agenda-sorting-strategy '(todo-state-up priority-down tag-up category-keep effort-down)))) ("P" "By priority" ((tags-todo "+PRIORITY=\"A\"") (tags-todo "+PRIORITY=\"B\"") (tags-todo "+PRIORITY=\"\"") (tags-todo "+PRIORITY=\"C\"")) ((org-agenda-prefix-format "%-10c %-10T %e ") (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down)))) ("pp" tags "+project-someday-TODO=\"DONE\"-TODO=\"SOMEDAY\"-inactive" ((org-tags-exclude-from-inheritance '("project")) (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down)))) ("p." tags "+project-TODO=\"DONE\"" ((org-tags-exclude-from-inheritance '("project")) (org-agenda-sorting-strategy '(priority-down tag-up category-keep effort-down)))) ("S" tags-todo "TODO=\"STARTED\"") ("C" "Cooking" ((tags "vegetables") (tags "chicken") (tags "beef") (tags "pork") (tags "other")) ((org-agenda-files '("~/sync/orgzly/cooking.org")) (org-agenda-view-columns-initially t) (org-agenda-sorting-strategy '(scheduled-up time-down todo-state-up))) ) ("8" "List projects with tasks" my-org-agenda-projects-and-tasks "+PROJECT" ((org-agenda-max-entries 3)))))
Shuffling my Org Mode unscheduled tasks emacs org
I enjoyed listening to Podcast #1,029: Treat Your To-Do List Like a River, and Other Mindset Shifts for Making Better Use of Your Time | The Art of Manliness (thanks @ctietze@mastodon.social for the recommendation) and checking out the Autofocus method (main website with translations) for reviewing your TODO list without worrying too much about prioritization. I also had an opportunity to reflect on similar topics in a conversation with John Wiegley and Adam Porter about personal information management (which I'll be blogging about once John has a chance to review the draft).
This nudged me to experiment with randomizing my unscheduled task list. I'm not trying to finish everything on my list, I'm just mixing it up so that I enjoy keeping things on my radar and picking something to do. org-ql lets me create randomly-sorted views, so I wrote some code to show me a shuffled list of my unscheduled TODO tasks and SOMEDAY tasks.
(defun my-org-ql-shuffle-todo () (interactive) (org-ql-search (org-agenda-files) '(and (todo "TODO" "STARTED") (not (done)) (not (scheduled)) (not (deadline)) (not (ts-active)) (not (tags "cooking"))) :sort 'random)) (defun my-org-ql-shuffle-someday () (interactive) (org-ql-search (org-agenda-files) '(and (todo "SOMEDAY") (not (done)) (not (scheduled)) (not (deadline)) (not (ts-active)) (not (tags "cooking"))) :sort 'random))
I can't make it part of my org-agenda-custom-commands
yet because of an open issue, but having separate commands is a starting point.
It's surprisingly fun. I used org-agenda-follow-mode
to quickly flip through the tasks while looking at the agenda. I've already noticed some tasks to cancel and picked some tasks to do. Could be neat!
Making it easier to tag inbox items
(setq org-complete-tags-always-offer-all-agenda-tags t) (setq org-use-fast-tag-selection nil)
Make it easy to mark a task as done
Great for quickly going through the to-do list. Gets rid of one extra keystroke. ;)
(defun my-org-agenda-done (&optional arg) "Mark current TODO as done. 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-mode file." (interactive "P") (org-agenda-todo "DONE")) ;; Override the key definition for org-exit (define-key org-agenda-mode-map "x" 'my-org-agenda-done)
Make it easy to mark a task as done and create a follow-up task
(defun my-org-agenda-mark-done-and-add-followup () "Mark the current TODO as done and add another task after it. Creates it at the same level as the previous task, so it's better to use this with to-do items than with projects or headings." (interactive) (org-agenda-todo "DONE") (org-agenda-switch-to) (org-capture 0 "t")) ;; Override the key definition (define-key org-agenda-mode-map "F" 'my-org-agenda-mark-done-and-add-followup)
Capture something based on the agenda
(defun my-org-agenda-new () "Create a new note or task at the current agenda item. Creates it at the same level as the previous task, so it's better to use this with to-do items than with projects or headings." (interactive) (org-agenda-switch-to) (org-capture 0)) ;; New key assignment (define-key org-agenda-mode-map "N" 'my-org-agenda-new)
Sorting by date and priority
(setq org-agenda-sorting-strategy '((agenda time-up priority-down tag-up category-keep) ;; (todo user-defined-up todo-state-up priority-down effort-up) (todo todo-state-up priority-down effort-up) ; (tags user-defined-up) (search category-keep))) (setq org-agenda-cmp-user-defined 'my-org-sort-agenda-items-user-defined) (require 'cl) (defun my-org-get-context (txt) "Find the context." (car (member-if (lambda (item) (string-match "@" item)) (get-text-property 1 'tags txt)))) (defun my-org-compare-dates (a b) "Return 1 if A should go after B, -1 if B should go after A, or 0 if a = b." (cond ((and (= a 0) (= b 0)) nil) ((= a 0) 1) ((= b 0) -1) ((> a b) 1) ((< a b) -1) (t nil))) (defun my-org-complete-cmp (a b) (let* ((state-a (or (get-text-property 1 'todo-state a) "")) (state-b (or (get-text-property 1 'todo-state b) ""))) (or (if (member state-a org-done-keywords-for-agenda) 1) (if (member state-b org-done-keywords-for-agenda) -1)))) (defun my-org-date-cmp (a b) (let* ((sched-a (or (get-text-property 1 'org-scheduled a) 0)) (sched-b (or (get-text-property 1 'org-scheduled b) 0)) (deadline-a (or (get-text-property 1 'org-deadline a) 0)) (deadline-b (or (get-text-property 1 'org-deadline b) 0))) (or (my-org-compare-dates (my-org-min-date sched-a deadline-a) (my-org-min-date sched-b deadline-b))))) (defun my-org-min-date (a b) "Return the smaller of A or B, except for 0." (funcall (if (and (> a 0) (> b 0)) 'min 'max) a b)) (defun my-org-sort-agenda-items-user-defined (a b) ;; compare by deadline, then scheduled date; done tasks are listed at the very bottom (or (my-org-complete-cmp a b) (my-org-date-cmp a b))) (defun my-org-context-cmp (a b) "Compare CONTEXT-A and CONTEXT-B." (let ((context-a (my-org-get-context a)) (context-b (my-org-get-context b))) (cond ((null context-a) +1) ((null context-b) -1) ((string< context-a context-b) -1) ((string< context-b context-a) +1) (t nil)))) (defun my-org-sort-agenda-items-todo (a b) (or (org-cmp-time a b) (my-org-complete-cmp a b) (my-org-context-cmp a b) (my-org-date-cmp a b) (org-cmp-todo-state a b) (org-cmp-priority a b) (org-cmp-effort a b)))
Preventing things from falling through the cracks
This helps me keep track of unscheduled tasks, because I sometimes forget to assign tasks a date. I also want to keep track of stuck projects.
(defun my-org-agenda-list-unscheduled (&rest ignore) "Create agenda view for tasks that are unscheduled and not done." (let* ((org-agenda-todo-ignore-with-date t) (org-agenda-overriding-header "List of unscheduled tasks: ")) (org-agenda-get-todos))) (setq org-stuck-projects '("+PROJECT-MAYBE-DONE" ("TODO") nil "\\<IGNORE\\>"))
Synchronizing with Google Calendar
(defun my-org-gcal-notify (title mes) (message "%s - %s" title mes)) (use-package org-gcal :if my-laptop-p :load-path "~/elisp/org-gcal.el" :init (fset 'org-gcal-notify 'my-org-gcal-notify))
Projects
(defun my-org-show-active-projects () "Show my current projects." (interactive) (org-tags-view nil "project-inactive-someday"))
Reviews
Weekly review
I regularly post weekly reviews to keep track of what I'm done, remind me to plan for the upcoming week, and list blog posts, sketches, and links. I want to try out grouping tasks by topic first, then breaking it down into previous/next week.
(use-package quantified :ensure nil :load-path "~/sync/cloud/elisp" :unless my-phone-p) (defvar my-weekly-review-line-regexp "^ \\([^:]+\\): +\\(Sched[^:]+: +\\)?TODO \\(.*?\\)\\(?:[ ]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ ]*$" "Regular expression matching lines to include.") (defvar my-weekly-done-line-regexp "^ \\([^:]+\\): +.*?\\(?:Clocked\\|Closed\\):.*?\\(TODO\\|DONE\\) \\(.*?\\)\\(?:[ ]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ ]*$" "Regular expression matching lines to include as completed tasks.") (defun my-quantified-get-hours (category time-summary) "Return the number of hours based on the time summary." (if (stringp category) (if (assoc category time-summary) (/ (cdr (assoc category time-summary)) 3600.0) 0) (apply '+ (mapcar (lambda (x) (my-quantified-get-hours x time-summary)) category)))) (defun _my-extract-tasks-from-agenda (string matchers prefix line-re) (with-temp-buffer (insert string) (goto-char (point-min)) (while (re-search-forward line-re nil t) (let ((temp-list matchers)) (while temp-list (if (save-match-data (string-match (car (car temp-list)) (match-string 1))) (progn (add-to-list (cdr (car temp-list)) (concat prefix (match-string 3)) t) (setq temp-list nil))) (setq temp-list (cdr temp-list))))))) (ert-deftest _my-extract-tasks-from-agenda () (let (list-a list-b (line-re "\\([^:]+\\):\\( \\)\\(.*\\)")) (_my-extract-tasks-from-agenda "listA: Task 1\nother: Task 2\nlistA: Task 3" '(("listA" . list-a) ("." . list-b)) "- [ ] " line-re) (should (equal list-a '("- [ ] Task 1" "- [ ] Task 3"))) (should (equal list-b '("- [ ] Task 2"))))) (defun _my-get-upcoming-tasks () (save-window-excursion (org-agenda nil "W") (_my-extract-tasks-from-agenda (buffer-string) '(("routines" . ignore) ("business" . business-next) ("people" . relationships-next) ("tasks" . emacs-next) ("." . life-next)) " - [ ] " my-weekly-review-line-regexp))) (defun _my-get-previous-tasks () (let (string) (save-window-excursion (org-agenda nil "W") (org-agenda-later -1) (org-agenda-log-mode 16) (setq string (buffer-string)) ;; Get any completed tasks from the current week as well (org-agenda-later 1) (org-agenda-log-mode 16) (setq string (concat string "\n" (buffer-string))) (_my-extract-tasks-from-agenda string '(("routines" . ignore) ("business" . business) ("people" . relationships) ("tasks" . emacs) ("." . life)) " - [X] " my-weekly-done-line-regexp)))) (defun my-org-summarize-focus-areas (date) "Summarize previous and upcoming tasks as a list." (interactive (list (org-read-date-analyze (if current-prefix-arg (org-read-date) "-fri") nil '(0 0 0)))) (let (business relationships life business-next relationships-next life-next string emacs emacs-next start end time-summary biz-time ignore base-date) (setq base-date (apply 'encode-time date)) (setq start (format-time-string "%Y-%m-%d" (days-to-time (- (time-to-number-of-days base-date) 6)))) (setq end (format-time-string "%Y-%m-%d" (days-to-time (1+ (time-to-number-of-days base-date))))) (setq time-summary (quantified-summarize-time start end)) (setq biz-time (my-quantified-get-hours "Business" time-summary)) (_my-get-upcoming-tasks) (_my-get-previous-tasks) (setq string (concat (format "- *A- (Childcare)* (%.1fh - %d%% of total)\n" (my-quantified-get-hours '("A-") time-summary) (/ (my-quantified-get-hours '("A-") time-summary) 1.68)) (format "- *Business* (%.1fh - %d%%)\n" biz-time (/ biz-time 1.68)) (mapconcat 'identity business "\n") "\n" (mapconcat 'identity business-next "\n") "\n" (format " - *Earn* (%.1fh - %d%% of Business)\n" (my-quantified-get-hours "Business - Earn" time-summary) (/ (my-quantified-get-hours "Business - Earn" time-summary) (* 0.01 biz-time))) (format " - *Build* (%.1fh - %d%% of Business)\n" (my-quantified-get-hours "Business - Build" time-summary) (/ (my-quantified-get-hours "Business - Build" time-summary) (* 0.01 biz-time))) (format " - *Connect* (%.1fh - %d%% of Business)\n" (my-quantified-get-hours "Business - Connect" time-summary) (/ (my-quantified-get-hours "Business - Connect" time-summary) (* 0.01 biz-time))) (format "- *Relationships* (%.1fh - %d%%)\n" (my-quantified-get-hours '("Discretionary - Social" "Discretionary - Family") time-summary) (/ (my-quantified-get-hours '("Discretionary - Social" "Discretionary - Family") time-summary) 1.68)) (mapconcat 'identity relationships "\n") "\n" (mapconcat 'identity relationships-next "\n") "\n" "\n" (format "- *Discretionary - Productive* (%.1fh - %d%%)\n" (my-quantified-get-hours "Discretionary - Productive" time-summary) (/ (my-quantified-get-hours "Discretionary - Productive" time-summary) 1.68)) (format " - *Drawing* (%.1fh)\n" (my-quantified-get-hours '("Discretionary - Productive - Drawing") time-summary)) (format " - *Emacs* (%.1fh)\n" (my-quantified-get-hours "Discretionary - Productive - Emacs" time-summary)) (mapconcat 'identity emacs "\n") "\n" (mapconcat 'identity emacs-next "\n") "\n" (format " - *Coding* (%.1fh)\n" (my-quantified-get-hours "Discretionary - Productive - Coding" time-summary)) (mapconcat 'identity life "\n") "\n" (mapconcat 'identity life-next "\n") "\n" (format " - *Sewing* (%.1fh)\n" (my-quantified-get-hours "Discretionary - Productive - Sewing" time-summary)) (format " - *Writing* (%.1fh)\n" (my-quantified-get-hours "Discretionary - Productive - Writing" time-summary)) (format "- *Discretionary - Play* (%.1fh - %d%%)\n" (my-quantified-get-hours "Discretionary - Play" time-summary) (/ (my-quantified-get-hours "Discretionary - Play" time-summary) 1.68)) (format "- *Personal routines* (%.1fh - %d%%)\n" (my-quantified-get-hours "Personal" time-summary) (/ (my-quantified-get-hours "Personal" time-summary) 1.68)) (format "- *Unpaid work* (%.1fh - %d%%)\n" (my-quantified-get-hours "Unpaid work" time-summary) (/ (my-quantified-get-hours "Unpaid work" time-summary) 1.68)) (format "- *Sleep* (%.1fh - %d%% - average of %.1f per day)\n" (my-quantified-get-hours "Sleep" time-summary) (/ (my-quantified-get-hours "Sleep" time-summary) 1.68) (/ (my-quantified-get-hours "Sleep" time-summary) 7) ))) (if (called-interactively-p 'any) (insert string) string)))
I use this to put together a quick summary of how I spent my time.
The following code makes it easy to add a line:
(defun my-org-add-line-item-task (task) (interactive "MTask: ") (org-insert-heading) (insert "[ ] " task) (let ((org-capture-entry '("t" "Tasks" entry (file+headline "~/sync/orgzly/organizer.org" "Tasks") ""))) (org-capture nil "t") (insert "TODO " task "\nSCHEDULED: <" (org-read-date) ">"))) ;(define-key org-mode-map (kbd "C-c t") 'my-org-add-line-item-task) (defun my-org-list-from-rss (url from-date &optional to-date) "Convert URL to an Org list" (with-current-buffer (url-retrieve-synchronously url) (goto-char (point-min)) (re-search-forward "<\\?xml") (goto-char (match-beginning 0)) (let* ((feed (xml-parse-region (point) (point-max))) (is-rss (> (length (xml-get-children (car feed) 'entry)) 0))) (mapconcat (lambda (link) (format "- %s\n" (org-link-make-string (car link) (cdr link)))) (if is-rss (mapcar (lambda (entry) (cons (xml-get-attribute (car (or (seq-filter (lambda (x) (string= (xml-get-attribute x 'rel) "alternate")) (xml-get-children entry 'link)) (xml-get-children entry 'link))) 'href) (elt (car (xml-get-children entry 'title)) 2))) (-filter (lambda (entry) (let ((entry-date (elt (car (xml-get-children entry 'updated)) 2))) (and (org-string<= from-date entry-date) (or (null to-date) (string< entry-date to-date))))) (xml-get-children (car feed) 'entry))) (mapcar (lambda (entry) (cons (caddr (car (xml-get-children entry 'link))) (caddr (car (xml-get-children entry 'title))))) (-filter (lambda (entry) (let ((entry-time (format-time-string "%Y-%m-%d" (date-to-time (elt (car (xml-get-children entry 'pubDate)) 2)) t))) (and (not (string< entry-time from-date)) (or (null to-date) (string< entry-time to-date))))) (xml-get-children (car (xml-get-children (car feed) 'channel)) 'item)))) ""))))
Now we put it all together…
(defun my-org-prepare-weekly-review (&optional date skip-urls) "Prepare weekly review template." (interactive (list (org-read-date nil nil nil "Ending on Fri: " nil "-fri"))) (let* ((post-date (current-time)) (base-date (apply 'encode-time (org-read-date-analyze date nil '(0 0 0)))) start end links prev (title (format-time-string "Weekly review: Week ending %B %e, %Y" base-date)) (post-location (concat (format-time-string "%Y/%m/" post-date) (my-make-slug title)))) (setq start (format-time-string "%Y-%m-%d 0:00" (days-to-time (- (time-to-number-of-days base-date) 6)) (current-time-zone))) (setq end (format-time-string "%Y-%m-%d 0:00" (days-to-time (1+ (time-to-number-of-days base-date))) (current-time-zone))) (setq prev (format-time-string "%Y-%m-%d 0:00" (days-to-time (- (time-to-number-of-days base-date) 7 6)) (current-time-zone))) (outline-next-heading) (insert "** " title " :weekly:\n" (format ":PROPERTIES: :EXPORT_DATE: %s :EXPORT_ELEVENTY_PERMALINK: %s :EXPORT_ELEVENTY_FILE_NAME: %s :END:\n" (format-time-string "%Y-%m-%dT%T%z") (concat "/blog/" post-location "/") (concat "blog/" post-location)) (my-org-summarize-journal-csv start end nil my-journal-category-map my-journal-categories) "\n\n*Blog posts*\n\n" (my-org-list-from-rss "https://sachachua.com/blog/feed" start end) "\n\n*Sketches*\n\n" (my-sketches-export-and-extract start end) "\n" "\n\n*Toots*\n\n" (my-mastodon-format-my-toots-since start) "\n\n#+begin_my_details Time\n" (orgtbl-to-orgtbl (my-quantified-compare prev start start end '("A-" "Business" "Discretionary - Play" "Unpaid work" "Discretionary - Social" "Discretionary - Family" "Sleep" "Discretionary - Productive" "Personal") "The other week %" "Last week %") nil) "\n#+end_my_details\n\n"))) (defun my-prepare-missing-weekly-reviews () "Prepare missing weekly reviews based on LAST_REVIEW property." (interactive) (let ((today (substring (org-read-date nil nil ".") 0 10)) (date (org-entry-get (point) "LAST_REVIEW"))) (while (string< date today) (setq date (substring (org-read-date nil nil "++1w" nil (org-time-string-to-time date)) 0 10)) (unless (string< today date) (save-excursion (my-org-prepare-weekly-review date)) (org-entry-put (point) "LAST_REVIEW" date)))))
Flickr extract
(defun _my-clean-up-flickr-list (list) (setq list (replace-regexp-in-string "\\[\"" "[" list)) (setq list (replace-regexp-in-string "<a href=\"\"\\([^\"]+\\).*?>.*?</a>" "[[\\1][\\2]]" list)) (setq list (replace-regexp-in-string "\" " "" (replace-regexp-in-string "\"\\]" "]" list)))) (defun _my-format-flickr-link-for-org (x) (let ((title (assoc-default "FileName" x))) (format "- %s %s" (org-link-make-string (assoc-default "URL" x) title) (if (string= (assoc-default "Description" x) "") "" (concat "- " (replace-regexp-in-string "<a href=\"\"\\(.*?\\)\"\".*?>\\(.*?\\)</a>" (lambda (string) (org-link-make-string (match-string 1 string) (match-string 2 string))) (assoc-default "Description" x))))))) (defun _my-parse-and-filter-flickr-csv-buffer (start end) (sort (delq nil (mapcar (lambda (x) (if (and (string< (assoc-default "FileName" x) end) (org-string<= start (assoc-default "FileName" x))) x)) (csv-parse-buffer t))) (lambda (a b) (string< (assoc-default "FileName" a) (assoc-default "FileName" b))))) (defun my-sketches-export-and-extract (start end &optional do-insert update-db filter) "Create a list of links to sketches." (interactive (list (org-read-date) (org-read-date) t current-prefix-arg (read-string "Filter: "))) (let ((value (mapconcat (lambda (filename) (let ((base (file-name-nondirectory filename))) (format "- %s\n" (org-link-make-string (replace-regexp-in-string "#" "%23" (concat "sketch:" base)) base)))) (let ((my-sketch-directories '("~/sync/sketches"))) (my-get-sketch-filenames-between-dates start end filter)) ""))) (if do-insert (insert value) value)))
Monthly reviews
I want to be able to see what I worked on in a month so that I can write my monthly reviews. This code makes it easy to display a month's clocked tasks and time. I haven't been particularly thorough in tracking time before, but now that I have a shortcut that logs in Quantified Awesome as well as in Org, I should end up clocking more.
(defun my-org-review-month (start-date) "Review the month's clocked tasks and time." (interactive (list (org-read-date))) ;; Set to the beginning of the month (setq start-date (concat (substring start-date 0 8) "01")) (let ((org-agenda-show-log t) (org-agenda-start-with-log-mode t) (org-agenda-start-with-clockreport-mode t) (org-agenda-clockreport-parameter-plist '(:link t :maxlevel 3))) (org-agenda-list nil start-date 'month)))
Here's a function like my-org-prepare-weekly-review
:
(defun my-list-blog-posts (start-date end-date) (seq-filter (lambda (o) (and (or (null start-date) (string< start-date (plist-get o :date))) (or (null end-date) (string< (plist-get o :date) end-date)))) (let ((json-object-type 'plist)) (json-read-file "~/proj/static-blog/_site/blog/all/index.json")))) (defun my-org-get-last-week () "Return dates for filtering last week." (if (string= (format-time-string "%u") "6") ;; my week starts on Saturday (cons (org-read-date nil nil "-1w") (org-read-date nil nil ".")) (cons (org-read-date nil nil "-2sat") (org-read-date nil nil "-sat")))) (defun my-org-get-month (&optional date-string) "Return start of month containing DATE and start of following month. Result is (START . NEXT)." (let* ((date (decode-time (if (stringp date-string) (org-read-date nil t date-string) date-string))) (month (elt date 4)) (year (elt date 5)) start-date end-date) (calendar-increment-month month year 1) (cons (format "%4d-%02d-01" (elt date 5) (elt date 4)) (format "%4d-%02d-01" year month)))) (defun my-org-prepare-monthly-review (time) (interactive (list (org-read-date nil t))) (let* ((date (decode-time time)) (month (elt date 4)) (year (elt date 5)) (post-date (current-time)) post-location title start-date end-date previous-date posts sketches org-date time) (calendar-increment-month month year -1) (setq start-date (format "%4d-%02d-01 0:00" year month) end-date (format "%4d-%02d-01 0:00" (elt date 5) (elt date 4)) title (format-time-string "Monthly review: %B %Y" (encode-time 0 0 0 1 month year)) post-location (concat (format-time-string "%Y/%m/" post-date) (my-make-slug title)) posts (mapconcat (lambda (o) (concat "- " (org-link-make-string (concat "https://sachachua.com" (plist-get o :permalink)) (plist-get o :title)))) (my-list-blog-posts (substring start-date 0 10) (substring end-date 0 10)) "\n") sketches (my-sketches-export-and-extract (substring start-date 0 10) (substring end-date 0 10) nil t)) (calendar-increment-month month year -1) (setq previous-date (format "%4d-%02d-01 0:00" year month)) (setq time (my-quantified-compare previous-date start-date start-date end-date '("Business" "Discretionary - Play" "Unpaid work" "A-" "Discretionary - Family" "Discretionary - Social" "Sleep" "Discretionary - Productive" "Personal") "Previous month %" "This month %")) (goto-char (line-end-position)) (insert "\n\n** " title " :monthly:review:\n" (my-org-summarize-journal-csv start-date end-date "monthly-highlight" my-journal-category-map my-journal-categories) "\n\n" "*Blog posts*\n" posts "\n\n" "*Sketches*\n\n" sketches "*Time*\n\n" (orgtbl-to-orgtbl time nil)) (my-org-11ty-prepare-subtree))) (defun my-org-prepare-yearly-review (previous-date start-date end-date) (let* ((posts (mapconcat (lambda (o) (concat "- " (org-link-make-string (concat "https://sachachua.com" (plist-get o :permalink)) (plist-get o :title)))) (my-list-blog-posts (substring start-date 0 10) (substring end-date 0 10)) "\n") ) (sketches (my-sketches-export-and-extract (substring start-date 0 10) (substring end-date 0 10) nil t)) (time (my-quantified-compare previous-date start-date start-date end-date '("Business" "Discretionary - Play" "Unpaid work" "A-" "Discretionary - Family" "Discretionary - Social" "Sleep" "Discretionary - Productive" "Personal") "2020-2021 %" "2021-2022 %")) ) (insert "*Blog posts*\n\n" posts "\n\n" "*Sketches*\n\n" sketches "*Time*\n\n" (orgtbl-to-orgtbl time nil))))
Filing
DONE Org Mode: Prompt for a heading and then refile it to point org
I sometimes want the inverse of org-refile
when
I create a subtree and think of things that should
probably go into it. This function prompts for a
heading that matches org-refile-targets
and then
moves it to the current location.
(defun my-org-refile-to-point (refloc) "Prompt for a heading and refile it to point." (interactive (list (org-refile-get-location "Heading: "))) (let* ((file (nth 1 refloc)) (pos (nth 3 refloc))) (save-excursion (with-current-buffer (find-file-noselect file 'noward) (save-excursion (save-restriction (widen) (goto-char pos) (org-copy-subtree 1 t)))) (org-paste-subtree nil nil nil t))))
TODO Bounce to another file computer phone
On my phone, Emacs in Termux is nice for scripting, and Orgzly is nice for editing long text. Let's see if this function lets me quickly bounce things around from one place to another.
(defun my-org-bounce-to-file (file) "Toggle subtree between its home file and another file. Limitations: Reinserts entry at bottom of subtree, uses kill ring." (interactive (list (read-file-name "File: "))) (if (string= (buffer-file-name) (expand-file-name file)) ;; Return it (let ((location (org-entry-get (point) "BOUNCE"))) (when location (setq location (read location)) (org-cut-subtree) (save-buffer) (with-current-buffer (find-file (car location)) (save-restriction (widen) (goto-char (org-find-olp location)) (org-end-of-subtree) (unless (bolp) (insert "\n")) (org-paste-subtree (length location) nil nil t) (save-buffer))))) (org-entry-put (point) "BOUNCE" (prin1-to-string (cons (buffer-file-name) (org-get-outline-path)))) (org-cut-subtree) (save-buffer) (with-current-buffer (find-file file) (save-restriction (widen) (goto-char (point-max)) (unless (bolp) (insert "\n")) (org-yank) (save-buffer)))))
Basic refiling configuration
org-refile
lets you organize notes by typing in the headline to file them under.
(setq org-reverse-note-order t) ; I want new notes prepended (setq org-refile-use-outline-path 'title) ; distinguish between files named the same (setq org-outline-path-complete-in-steps nil) (setq org-refile-allow-creating-parent-nodes 'confirm) (setq org-refile-use-cache t) (setq org-blank-before-new-entry nil) (setq org-refile-targets '((("~/sync/orgzly/organizer.org" "~/sync/orgzly/routines.org" "~/sync/orgzly/business.org" "~/sync/orgzly/reference.org" "~/sync/orgzly/garden.org" "~/sync/orgzly/decisions.org" "~/sync/emacs/Sacha.org" "~/sync/orgzly/posts.org" "~/sync/orgzly/people.org" "~/sync/orgzly/resources.org" "~/sync/orgzly/Inbox.org" "~/proj/emacsconf/wiki/2023/organizers-notebook/index.org") . (:maxlevel . 7)) (("~/proj/quantified/notes.org" "~/proj/sketches/notes.org" "~/sync/static-blog/notes.org" "~/proj/journal/notes.org" "~/sync/orgzly/crafts.org" "~/sync/orgzly/misc.org") . (:maxlevel . 2)) (("~/sync/orgzly/news.org") . (:maxlevel . 1)) ))
TEACH Jump to Org location by substring
;; Example: (org-refile 4 nil (my-org-refile-get-location-by-substring "Other Emacs")) (defun my-org-refile-get-location-by-substring (regexp &optional file) "Return the refile location identified by REGEXP." (let ((org-refile-targets org-refile-targets) tbl) (setq org-refile-target-table (org-refile-get-targets))) (unless org-refile-target-table (user-error "No refile targets")) (cl-find regexp org-refile-target-table :test (lambda (a b) (and (string-match a (car b)) (or (null file) (string-match file (elt b 1))))))) (defun my-org-refile-subtree-to (name) (org-refile nil nil (my-org-refile-get-location-exact name))) (defun my-org-refile-get-location-exact (name &optional file) "Return the refile location identified by NAME." (let ((org-refile-targets org-refile-targets) tbl) (setq org-refile-target-table (org-refile-get-targets))) (unless org-refile-target-table (user-error "No refile targets")) (cl-find name org-refile-target-table :test (lambda (a b) (and (string-equal a (car b)) (or (null file) (string-match file (elt b 1))))))) ;; Example: (my-org-clock-in-refile "Off my computer") (defun my-org-clock-in-refile (location &optional file) "Clocks into LOCATION. LOCATION and FILE can also be regular expressions for `my-org-refile-get-location-by-substring'." (interactive (list (my-org-refile-get-location))) (save-window-excursion (save-excursion (if (stringp location) (setq location (my-org-refile-get-location-by-substring location file))) (org-refile 4 nil location) (org-clock-in)))) (defun my-org-finish-previous-task-and-clock-in-new-one (location &optional file) (interactive (list (my-org-refile-get-location))) (save-window-excursion (org-clock-goto) (org-todo 'done)) (my-org-clock-in-and-track-by-name location file)) (defun my-org-clock-in-and-track-by-name (location &optional file) (interactive (list (my-org-refile-get-location))) (save-window-excursion (save-excursion (if (stringp location) (setq location (my-org-refile-get-location-exact location file))) (org-refile 4 nil location) (my-org-clock-in-and-track)))) (defun my-org-off-my-computer (category) (interactive "MCategory: ") (eval-when-compile (require 'quantified nil t)) (my-org-clock-in-refile "Off my computer") (quantified-track category))
Quick way to jump
(defun my-org-jump () (interactive) (let ((current-prefix-arg '(4))) (call-interactively 'org-refile)))
TODO Refile inbox entries to a smaller set of org-refile-targets dotemacs
When I'm filing things from my inbox, I want a faster refile that considers a smaller set of entries.
(defun my-org-refile-to-subset (arg) "Refile to a smaller set of targets." (interactive "P") (let ((org-refile-targets '(("~/sync/orgzly/organizer.org" . (:tag . "inboxtarget")) ("~/sync/orgzly/organizer.org" . (:maxlevel . 3)) ("~/sync/orgzly/resources.org" . (:maxlevel . 1)) (nil . (:level . 1)) ("~/proj/stream/index.org" . (:maxlevel . 3)) ("~/sync/emacs/Inbox.org" . (:maxlevel . 1)) ("~/sync/emacs/Sacha.org" . (:maxlevel . 4)) ("~/sync/orgzly/people.org" . (:maxlevel . 2))))) (org-refile arg))) (defun my-org-refile-to-target-or-subset (&optional arg) (interactive "P") (or (my-org-refile-current-entry-to-tag-target) (my-org-refile-to-subset arg))) (keymap-global-set "C-c w" 'my-org-refile-to-target-or-subset)
Next steps might include filtering out private stuff, but I don't think I'll use this while streaming, so it might be okay for now.
Moving lines around
This makes it easier to reorganize lines in my weekly review.
(defun my-org-move-line-to-destination () "Moves the current list item to DESTINATION in the current buffer. If no DESTINATION is found, move it to the end of the list and indent it one level." (interactive) (save-window-excursion (save-excursion (let ((string (buffer-substring-no-properties (line-beginning-position) (line-end-position))) (case-fold-search nil) found) (delete-region (line-beginning-position) (1+ (line-end-position))) (save-excursion (goto-char (point-min)) (when (re-search-forward "DESTINATION" nil t) (insert "\n" (make-string (- (match-beginning 0) (line-beginning-position)) ?\ ) (s-trim string)) (setq found t))) (unless found (org-end-of-item-list) (insert string "\n"))))))
(defun my-org-move-line-to-end-of-list () "Move the current list item to the end of the list." (interactive) (save-excursion (let ((string (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) (delete-region (line-beginning-position) (1+ (line-end-position))) (org-end-of-item-list) (insert string))))
Organizing my blog index
(defun my-org-file-blog-index-entries () "Keep filing until I press `C-g'." (interactive) (while t (my-org-file-blog-index-entry (line-beginning-position) (1+ (line-end-position)) (let ((org-refile-targets '(("~/proj/sharing/blog.org" . (:maxlevel . 3))))) (save-excursion (org-refile-get-location "Location")))))) (defun my-org-file-blog-index-entry (beg end location) "Copy entries into blog.org." (interactive (list (if (region-active-p) (point) (line-beginning-position)) (if (region-active-p) (mark) (1+ (line-end-position))) (let ((org-refile-targets '(("~/proj/sharing/blog.org" . (:maxlevel . 3))))) (save-excursion (org-refile-get-location "Location"))))) (let ((s (replace-regexp-in-string "^[ \t]*- \\(\\[X\\] \\)?" "- [X] " (buffer-substring-no-properties beg end)))) ;; if we're already in blog.org, delete the previous entry (if (string= buffer-file-name (expand-file-name "~/proj/sharing/blog.org")) (delete-region beg end)) (save-window-excursion (save-excursion (find-file (nth 1 location)) (save-excursion (save-restriction (widen) (goto-char (nth 3 location)) (re-search-forward org-list-full-item-re nil t) (goto-char (line-beginning-position)) (insert s) (org-update-statistics-cookies nil)))))))
Refiling Org Mode notes to headings in the same file org emacs
I spent some time tidying up my Emacs
configuration . I used org-babel-demarcate-block
to split up some long #+begin_src...#+end_src
blocks and refiled sections to group them
together. I also promoted more sections to
top-level headings in order to make the most of
the side navigation provided by the Read the Org
setup file based on Read the Docs. These functions
were helpful:
(defun my-org-refile-in-file (&optional prefix) "Refile to a target within the current file." (interactive) (let ((org-refile-targets (list (cons nil '(:maxlevel . 5))))) (call-interactively 'org-refile))) (defun my-org-refile-to-previous () "Refile subtree to last position from `my-org-refile-in-file'." (interactive) (save-selected-window (when (eq major-mode 'org-agenda-mode) (org-agenda-switch-to)) (org-cut-subtree) (save-window-excursion (save-excursion (bookmark-jump (plist-get org-bookmark-names-plist :last-refile)) (let ((level (org-current-level))) (org-end-of-subtree t t) (org-paste-subtree)))))) (with-eval-after-load 'org (push '("w" call-interactively 'org-refile) org-speed-commands) (push '("W" call-interactively 'my-org-refile-in-file) org-speed-commands) (push '("." call-interactively 'my-org-refile-to-previous) org-speed-commands))
I usually have org-refile-targets
set to a long
list of files so that I can use C-u C-c C-w
to
jump to headings from anywhere, but I just wanted
to refile other things in my configuration, so it
was nice to limit the scope to just that file.
I like using org-speed-commands
to give me quick
shortcuts when I'm at headings.
Contacts
(use-package org-contacts :config (setq org-contacts-files '("~/sync/orgzly/people.org")))
Inserting code
(defun my-org-insert-defun (function) "Inserts an Org source block with the definition for FUNCTION." (interactive (find-function-read)) (let* ((buffer-point (condition-case nil (find-definition-noselect function nil) (error nil))) (new-buf (car buffer-point)) (new-point (cdr buffer-point)) definition) (if (and buffer-point new-point) (with-current-buffer new-buf ;; Try to get original definition (save-excursion (goto-char new-point) (setq definition (buffer-substring-no-properties (point) (save-excursion (end-of-defun) (point)))))) ;; Fallback: Print function definition (setq definition (concat (prin1-to-string (symbol-function function)) "\n"))) (if (org-in-src-block-p) (insert definition) (insert "#+begin_src emacs-lisp\n" definition "#+end_src\n")))) (defun my-org-insert-function-and-key (keys) (interactive (caar (help--read-key-sequence))) (insert (format "=%s= (=%s=)" (symbol-name (key-binding keys t)) (key-description keys))))
(use-package org :hook (org-mode . org-indent-mode) :config (setq org-indent-indentation-per-level 2) (setq org-edit-src-content-indentation 0) (setq org-src-preserve-indentation t))
Org Babel
(setq org-babel-default-header-args '((:session . "none") (:results . "drawer replace") (:comments . "link") (:exports . "code") (:cache . "no") (:eval . "never-export") (:hlines . "no") (:tangle . "no"))) (setq org-edit-src-auto-save-idle-delay 5)
Format source
gists/format-org-mode-source-blocks.el at 118c5a579a231862f4d1a548afe071e450af4e03 - gists - Forgejo
(use-package format-all :if my-laptop-p) (use-package org :config (defun my/format-all-advice () (ignore-errors ; in case there's no language support (format-all-buffer))) (advice-add #'org-edit-src-exit :before #'my/format-all-advice))
Execute named babel block
(defun my-org-execute-src-block-by-name (name) (interactive (list (completing-read "Block: "(org-babel-src-block-names)))) (save-excursion (goto-char (point-min)) (when (re-search-forward (format "^#\\+NAME:[ \t]+%s[ \t]*$" (regexp-quote name)) nil t) (org-babel-execute-src-block))))
JSON
From https://isamert.net/2022/01/04/dealing-with-apis-jsons-and-databases-in-org-mode.html
(defun org-babel-execute:json (body params) (let ((jq (cdr (assoc :jq params))) (node (cdr (assoc :node params)))) (cond (jq (with-temp-buffer ;; Insert the JSON into the temp buffer (insert body) ;; Run jq command on the whole buffer, and replace the buffer ;; contents with the result returned from jq (shell-command-on-region (point-min) (point-max) (format "jq -r \"%s\"" jq) nil 't) ;; Return the contents of the temp buffer as the result (buffer-string))) (node (with-temp-buffer (insert (format "const it = %s;" body)) (insert node) (shell-command-on-region (point-min) (point-max) "node -p" nil 't) (buffer-string))))))
JQ
(use-package jq-mode :vc (:url "https://github.com/ljos/jq-mode") :config (org-babel-do-load-languages 'org-babel-load-languages '((jq . t))))
Fix block indentation
(defun my-org-fix-block-indentation () "Fix the indentation of the current src block." (interactive) (org-edit-special) (indent-region (point-min) (point-max)) (org-edit-src-exit))
Let's try literate-elisp
(use-package literate-elisp :if my-laptop-p)
Then I should be able to use literate-elisp-load-file
and still be able to jump to functions by definition.
Publishing
DONE Remove heading from TOC
(defun my-org-html-toc (depth info &optional scope) "Build a table of contents. DEPTH is an integer specifying the depth of the table. INFO is a plist used as a communication channel. Optional argument SCOPE is an element defining the scope of the table. Return the table of contents as a string, or nil if it is empty." (let ((toc-entries (mapcar (lambda (headline) (cons (org-html--format-toc-headline headline info) (org-export-get-relative-level headline info))) (org-export-collect-headlines info depth scope)))) (when toc-entries (let* ((toc-id-counter (plist-get info :org-html--toc-counter)) (toc (concat (format "<div class=\"text-table-of-contents toc-id%s\" role=\"doc-toc\">" (if toc-id-counter (format "-%d" toc-id-counter) "")) (org-html--toc-text toc-entries) "</div>\n"))) (plist-put info :org-html--toc-counter (1+ (or toc-id-counter 0))) (if scope toc (let ((outer-tag (if (org-html--html5-fancy-p info) "nav" "div"))) (concat (format "<%s class=\"table-of-contents toc-id%s\" role=\"doc-toc\">\n" outer-tag (if toc-id-counter (format "-%d" toc-id-counter) "")) ;; (let ((top-level (plist-get info :html-toplevel-hlevel))) ;; (format "<h%d>%s</h%d>\n" ;; top-level ;; (org-html--translate "Table of Contents" info) ;; top-level)) toc (format "</%s>\n" outer-tag)))))))) (with-eval-after-load 'org (defalias 'org-html-toc #'my-org-html-toc))
Include inline SVGs in Org Mode HTML and Markdown exports emacs org images
- : Fixed path when inlining file URLs.
#+ATTR_HTML :data-link t
to make it link instead of include.
: Now I can specify - : Whoops, forgot to make sure ox-11ty is also covered.
In my Org Mode HTML and Markdown exports, I
usually want to include SVGs inline so that I can
use links. Sometimes I also want to use Javascript
and CSS to modify elements within the images. I
used to use a my-include: link to do this, but I
realized that I can also modify this behaviour by
making my own functions that call org-html-link
or org-md-link
and then put those functions in
org-export-backend-transcoders
.
Here is an example of an SVG:
The following code overrides HTML and Markdown exports to include SVGs.
(defun my-ox-link-path (link _ info) (let* ((raw-path (org-element-property :path link))) (setq raw-path (org-export-file-uri (org-publish-file-relative-name raw-path info))) ;; Possibly append `:html-link-home' to relative file ;; name. (let ((home (and (plist-get info :html-link-home) (org-trim (plist-get info :html-link-home))))) (when (and home (plist-get info :html-link-use-abs-url) (not (file-name-absolute-p raw-path))) (setq raw-path (concat (file-name-as-directory home) raw-path)))) raw-path)) (defun my-org-html-link (link desc info) (if (and (string= (org-element-property :type link) "file") (not (plist-get (org-export-read-attribute :attr_html (org-element-parent-element link)) :data-link)) (org-export-inline-image-p link (plist-get info :html-inline-image-rules))) (let ((path (org-element-property :path link)) (attr (org-export-read-attribute :attr_html (org-element-parent-element link)))) (if (string= (file-name-extension path) "svg") (with-temp-buffer (if attr (replace-regexp-in-string "<svg " (concat "<svg " (org-html--make-attribute-string attr) " ") (buffer-string)) (buffer-string))) (org-html-link link desc info))) (org-html-link link desc info))) (defun my-org-md-link (link desc info) (if (and (string= (org-element-property :type link) "file") (not (plist-get (org-export-read-attribute :attr_html (org-element-parent-element link)) :data-link))) (let ((path (org-element-property :path link))) (if (string= (file-name-extension path) "svg") (with-temp-buffer (insert-file-contents-literally path) (buffer-string)) (org-md-link link desc info))) (org-md-link link desc info))) (defun my-org-11ty-link (link desc info) (if (and (string= (org-element-property :type link) "file") (not (plist-get (org-export-read-attribute :attr_html (org-element-parent-element link)) :data-link)) (not desc)) (let ((path (org-element-property :path link)) (attr (org-export-read-attribute :attr_html (org-element-parent-element link)))) (if (string= (file-name-extension path) "svg") (with-temp-buffer (insert-file-contents-literally path) (if attr (replace-regexp-in-string "<svg " (concat "<svg " (org-html--make-attribute-string attr) " ") (buffer-string)) (buffer-string))) (org-11ty-link link desc info))) (org-11ty-link link desc info))) (with-eval-after-load 'ox-html (setf (alist-get 'link (org-export-backend-transcoders (org-export-get-backend 'html))) 'my-org-html-link)) (with-eval-after-load 'ox-md (setf (alist-get 'link (org-export-backend-transcoders (org-export-get-backend 'md))) 'my-org-md-link)) (with-eval-after-load 'ox-11ty (setf (alist-get 'link (org-export-backend-transcoders (org-export-get-backend '11ty))) 'my-org-11ty-link))
Counting words without blocks
(defun my-org-subtree-text-without-blocks () "Don't include source blocks or links." (let ((text "")) (save-excursion (save-restriction (org-back-to-heading) (org-narrow-to-subtree) (org-end-of-meta-data) (setq text (buffer-substring (point) (point-max))))) (with-temp-buffer (insert text) (org-mode) (goto-char (point-min)) (while (re-search-forward org-link-any-re nil t) (replace-match (or (match-string 3) "(link)"))) (goto-char (point-min)) (while (re-search-forward "^ *#\\+begin" nil t) (let ((block (org-element-context))) (unless (eq (org-element-type block) 'quote-block) (delete-region (org-element-begin block) (org-element-end block))))) (while (re-search-forward "\n\n+" nil t) (replace-match "\n")) (string-trim (buffer-string))))) (defun my-org-subtree-count-words-without-blocks () (interactive) (let ((text (my-org-subtree-text-without-blocks))) (with-temp-buffer (insert text) (message "%s" (count-words--buffer-format))))) (defun my-org-subtree-copy-words-without-blocks () (interactive) (kill-new (my-org-subtree-text-without-blocks)))
Org Mode: Including portions of files between two regular expressions org emacs
- 2023-10-11 Wed: Include images inline.
- 2023-09-10: Use
consult-line
instead ofconsult--line
.
I'd like to refer to snippets of code, but lines are too fragile to
use as references for code and posts that I want to easily update. I'd
like to specify a from-regexp
and a to-regexp
instead in order to
collect the lines between those regexps (including the ones with the
regexps themselves). org-export-expand-include-keyword
looked a bit
hairy to extend since it uses regular expressions to match parameter
values. For this quick experiment, I decided to make a custom link
type instead. This allows me to refer to parts of code with a link like this:
[[my-include:~/proj/static-blog/assets/css/style.css::from-regexp=Start of copy code&to-regexp=End of copy code&wrap=src js]]
which will turn into this snippet from my stylesheet:
Start of copy code */ pre.src { margin: 0 } .org-src-container { position: relative; margin: 0 0; padding: 1.75rem 0 1.75rem 1rem; } div > details { padding: 20px; border: 1px solid lightgray } .org-src-container > details { padding: 0; border: none } details > .org-src-container { padding: 0; border: none } summary { position: relative; } summary .org-src-container { padding: 0 } summary .org-src-container pre.src { margin: 0 } .org-src-container button.copy-code, summary button.copy-code { position: absolute; top: 0px; right: 0px; } /*
Here's the Emacs Lisp code to do that. my-include-complete
function
reuses my-include-open
to narrow to the file, and
my-include-complete
uses consult-line
so that we can specify the
prompt.
(org-link-set-parameters "my-include" :follow #'my-include-open :export #'my-include-export :complete #'my-include-complete) (defun my-include-open (path &optional _) "Narrow to the region specified in PATH." (require 'org-protocol) (let (params start end) (if (string-match "^\\(.*+?\\)\\(?:::\\|\\?\\)\\(.*+\\)" path) (setq params (save-match-data (org-protocol-convert-query-to-plist (match-string 2 path))) path (match-string 1 path))) (find-file path) (if (plist-get params :name) (when (org-babel-find-named-block (plist-get params :name)) (goto-char (org-babel-find-named-block (plist-get params :name))) (let ((block (org-element-context))) (narrow-to-region (org-element-begin block) (org-element-end block)))) (setq start (or (and (plist-get params :from-regexp) (progn (goto-char (point-min)) (when (re-search-forward (url-unhex-string (plist-get params :from-regexp))) (line-beginning-position)))) (progn (goto-char (point-min)) (point)))) (setq end (or (and (plist-get params :to-regexp) (progn (when (re-search-forward (url-unhex-string (plist-get params :to-regexp))) (line-end-position)))) (progn (goto-char (point-max)) (point)))) (when (or (not (= start (point-min))) (not (= end (point-max)))) (narrow-to-region start end))))) (defun my-include-export (path _ format _) "Export PATH to FORMAT using the specified wrap parameter." (require 'org-protocol) (let (params body start end) (when (string-match "^\\(.*+?\\)\\(?:::\\|\\?\\)\\(.*+\\)" path) (setq params (save-match-data (org-protocol-convert-query-to-plist (match-string 2 path))) path (match-string 1 path))) (with-temp-buffer (insert-file-contents-literally path) (when (string-match "\\.org$" path) (org-mode)) (if (plist-get params :name) (when (org-babel-find-named-block (plist-get params :name)) (goto-char (org-babel-find-named-block (plist-get params :name))) (let ((block (org-element-context))) (setq start (org-element-begin block) end (org-element-end block)))) (goto-char (point-min)) (when (plist-get params :from-regexp) (re-search-forward (url-unhex-string (plist-get params :from-regexp))) (goto-char (match-beginning 0))) (setq start (point)) (setq end (point-max)) (when (plist-get params :to-regexp) (re-search-forward (url-unhex-string (plist-get params :to-regexp))) (setq end (match-beginning 0)))) (setq body (buffer-substring start end))) (with-temp-buffer (when (plist-get params :wrap) (let* ((wrap (plist-get params :wrap)) block args) (when (string-match "\\<\\(\\S-+\\)\\( +.*\\)?" wrap) (setq block (match-string 1 wrap)) (setq args (match-string 2 wrap)) (setq body (format "#+BEGIN_%s%s\n%s\n#+END_%s\n" block (or args "") body block))))) (when (plist-get params :summary) (setq body (format "#+begin_my_details %s\n%s\n#+end_my_details\n" (plist-get params :summary) body))) (insert body) (org-export-as format nil nil t)))) (defun my-include-complete () "Include a section of a file from one line to another, specified with regexps." (interactive) (require 'consult) (let ((file (read-file-name "File: "))) (save-window-excursion (find-file file) (concat "my-include:" file "?from-regexp=" (let ((curr-line (line-number-at-pos (point) consult-line-numbers-widen)) (prompt "From line: ")) (goto-char (point-min)) (consult-line) (url-hexify-string (regexp-quote (buffer-substring (line-beginning-position) (line-end-position))))) "&to-regexp=" (let ((curr-line (line-number-at-pos (point) consult-line-numbers-widen)) (prompt "To line: ")) (goto-char (point-min)) (consult-line nil (point)) (url-hexify-string (regexp-quote (buffer-substring (line-beginning-position) (line-end-position))))) "&wrap=src " (replace-regexp-in-string "-mode$" "" (symbol-name major-mode))))))
my-include-complete
This code displays the images inline.
(defun my-org-display-included-images (&optional include-linked refresh beg end) "Display inline images for my-include types." (interactive "P") (when (display-graphic-p) (when refresh (org-remove-inline-images beg end) (when (fboundp 'clear-image-cache) (clear-image-cache))) (let ((end (or end (point-max)))) (org-with-point-at (or beg (point-min)))) (let* ((case-fold-search t) (file-extension-re "\\.svg") (file-types-re (format "\\[\\[my-include:"))) (while (re-search-forward file-types-re end t) (let* ((link (org-element-lineage (save-match-data (org-element-context)) 'link t)) (inner-start (match-beginning 1)) (path (cond ((not link) nil) ;; file link without a description ((or (not (org-element-contents-begin link)) include-linked) (org-element-property :path link)) ((not inner-start) nil) (t (org-with-point-at inner-start (and (looking-at (if (char-equal ?< (char-after inner-start)) org-link-angle-re org-link-plain-re)) ;; File name must fill the whole ;; description. (= (org-element-contents-end link) (match-end 0)) (progn (setq linktype (match-string 1)) (match-string 2)))))))) (when (string-match "\\(.+\\)\\?" path) (setq path (match-string 1 path))) (when (and path (string-match-p file-extension-re path)) (let ((file (expand-file-name path))) ;; Expand environment variables. (when file (setq file (substitute-in-file-name file))) (when (and file (file-exists-p file)) (let ((width (org-display-inline-image--width link)) (old (get-char-property-and-overlay (org-element-begin link) 'org-image-overlay))) (if (and (car-safe old) refresh) (image-flush (overlay-get (cdr old) 'display)) (let ((image (org--create-inline-image file width))) (when image (let ((ov (make-overlay (org-element-begin link) (progn (goto-char (org-element-end link)) (skip-chars-backward " \t") (point))))) ;; FIXME: See bug#59902. We cannot rely ;; on Emacs to update image if the file ;; has changed. (image-flush image) (overlay-put ov 'display image) (overlay-put ov 'face 'default) (overlay-put ov 'org-image-overlay t) (overlay-put ov 'modification-hooks (list 'org-display-inline-remove-overlay)) (when (boundp 'image-map) (overlay-put ov 'keymap image-map)) (push ov org-inline-image-overlays))))))))))))))
ox-epub
(use-package ox-epub :if my-laptop-p :config (setq org-epub-style-default (concat org-epub-style-default "\n p.my-verse { white-space: pre }\n")))
Copy linked file and change link
(defun my-org-copy-linked-file-and-change-link (destination) (interactive (list (read-file-name (format "Copy %s to: " (file-name-nondirectory (org-element-property :path (org-element-context))))))) (let* ((elem (org-element-context)) (path (org-element-property :path elem)) (description (org-element-property :description elem))) (copy-file path destination t) (delete-region (org-element-begin elem) (org-element-end elem)) (insert (org-link-make-string (concat "file:" (file-relative-name (if (file-directory-p destination) (expand-file-name (file-name-nondirectory path) destination) destination))) description)))) (defun my-org-copy-linked-files (destination) (interactive (list (read-file-name (format "Copy %s to: " (file-name-nondirectory (org-element-property :path (org-element-context))))))) (while (re-search-forward "file:" nil t) (let* ((elem (org-element-context)) (path (org-element-property :path elem)) (description (org-element-property :description elem))) (unless (string-match (concat "^" (regexp-quote (expand-file-name destination))) (expand-file-name path)) (my-org-copy-linked-file-and-change-link destination)))))
Org Mode: Create a quick timestamped note and capture a screenshot emacs org
I wanted to be able to quickly create timestamped notes and possibly
capture a screenshot. Prompting for a value inside an
org-capture-template
disrupts my screen a little, so maybe this will
make it as easy as possible. I could probably do this without going
through org-capture-templates, but I wanted to take advantage of the
fact that Org Mode will deal with the date tree and finding the right
position itself.
(defvar my-screenshot-directory "~/recordings") (defun my-org-insert-screenshot (file &optional note) (interactive (list (if current-prefix-arg (expand-file-name (consult--read (reverse (directory-files my-screenshot-directory nil "\\.png$")) :sort nil :require-match t :category 'file :state (lambda (candidate state) (when candidate (with-current-buffer (find-file-noselect (expand-file-name candidate my-screenshot-directory)) (display-buffer (current-buffer)))))) my-screenshot-directory) (my-latest-file my-screenshot-directory)))) (if (derived-mode-p 'mastodon-toot-mode) (mastodon-toot--attach-media file (or note (read-string "Caption: "))) (save-window-excursion (if (string-match "webm" file) (progn (mpv-play file) (insert (org-link-make-string (concat "video:" file "?caption=" (or note (read-string "Caption: ")))) "\n")) (with-current-buffer (find-file-noselect file) (display-buffer (current-buffer))) (insert "#+CAPTION: " (or note (read-string "Caption: ")) "\n" (org-link-make-string (concat "file:" file))))))) (defun my-copy-last-screenshot-to-file (new-filename) (interactive (list (read-file-name (format "Copy %s to: " (file-name-nondirectory (my-latest-file my-screenshot-directory)))))) (copy-file (my-latest-file my-screenshot-directory) new-filename)) (defun my-copy-last-screenshot-and-insert-into-org (new-filename caption) (interactive (list (read-file-name (format "Copy %s to: " (file-name-nondirectory (my-latest-file my-screenshot-directory)))) (read-string "Caption: "))) (copy-file (my-latest-file my-screenshot-directory) new-filename t) (insert "#+CAPTION: " caption "\n" (org-link-make-string (concat "file:" (file-relative-name new-filename))) "\n"))
(defun my-org-capture-prefill-template (template &rest values) "Pre-fill TEMPLATE with VALUES." (setq template (or template (org-capture-get :template))) (with-temp-buffer (insert template) (goto-char (point-min)) (while (re-search-forward (concat "%\\(" "\\[\\(.+\\)\\]\\|" "<\\([^>\n]+\\)>\\|" "\\([tTuUaliAcxkKInfF]\\)\\|" "\\(:[-a-zA-Z]+\\)\\|" "\\^\\({\\([^}]*\\)}\\)" "?\\([gGtTuUCLp]\\)?\\|" "%\\\\\\([1-9][0-9]*\\)" "\\)") nil t) (if (car values) (replace-match (car values) nil t)) (setq values (cdr values))) (buffer-string))) (defun my-capture-timestamped-note (time note) "Disable Helm and capture a quick timestamped note." (interactive (list (current-time) (read-string "Note: "))) (let ((helm-completing-read-handlers-alist '((org-capture . nil))) (entry (org-capture-select-template "p"))) (org-capture-set-plist entry) (org-capture-get-template) (org-capture-set-target-location) (org-capture-put :template (org-capture-fill-template (my-org-capture-prefill-template (org-capture-get :template) (format-time-string "%H:%M:%S,%3N") note))) (org-capture-place-template) (org-capture-finalize))) (defun my-capture-timestamped-note-with-screenshot (time note) "Include a link to the latest screenshot." (interactive (list (current-time) (read-string "Note: "))) (kill-new (my-latest-file my-screenshot-directory)) (my-capture-timestamped-note time note))
11ty static site generation
(use-package ox-11ty :if my-laptop-p :load-path "~/proj/ox-11ty" :config (advice-add 'org-11ty--front-matter :filter-return #'my-org-11ty-rewrite-tags)) (defvar my-org-11ty-serve-process nil) (defun my-org-11ty-rewrite-tags (info) "Turn OneWordTags into one-word-tags." (require 's) (dolist (field '(:categories :tags)) (when (plist-get info field) (plist-put info field (mapcar (lambda (s) (if (string-match "^_" s) s (s-dashed-words s))) (plist-get info field))))) info) (defun my-org-11ty-unpublish-current-post () (interactive) (when (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") (delete-directory (expand-file-name (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") my-11ty-base-dir) t) (delete-directory (expand-file-name (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") (expand-file-name "_site" my-11ty-base-dir)) t) (org-delete-property "EXPORT_ELEVENTY_FILE_NAME") (org-delete-property "EXPORT_DATE") (org-delete-property "EXPORT_ELEVENTY_PERMALINK"))) (defalias 'my-org-11ty-delete-current-post #'my-org-11ty-unpublish-current-post) (defun my-org-11ty-copy-permalink () (interactive) (kill-new (concat "https://sachachua.com" (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK")))) (defun my-org-11ty-browse-local () (interactive) (unless (seq-find (lambda (o) (string-match "--serve" (assoc-default 'args (cdr o) nil ""))) (proced-process-attributes)) (let ((default-directory "~/proj/static-blog")) (setq my-org-11ty-serve-process (start-process "serve" nil "make" "serve")))) (browse-url "http://localhost:8080/blog")) (defun my-org-11ty-serve-stop () (interactive) (if (process-live-p my-org-11ty-serve-process) (stop-process my-org-11ty-serve-process) (when-let ((proc (seq-find (lambda (o) (string-match "--serve" (assoc-default 'args (cdr o) nil ""))) (proced-process-attributes)))) (call-process "kill" nil nil nil (number-to-string) (car proc))))) (defun my-org-11ty-prepare-subtree () (interactive) (unless (or (org-entry-get (point) "EXPORT_DATE") (org-entry-get-with-inheritance "DATE")) (org-entry-put (point) "EXPORT_DATE" (format-time-string "%Y-%m-%dT%T%z"))) (let ((path (concat "blog/" (format-time-string "%Y/%m/") (my-make-slug (org-get-heading t t t t)) "/"))) (unless (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK") (org-entry-put (point) "EXPORT_ELEVENTY_PERMALINK" (concat "/" path))) (unless (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") (org-entry-put (point) "EXPORT_ELEVENTY_FILE_NAME" path)))) (defun my-org-11ty-rename-subtree () (interactive) (let ((new-path (concat "blog/" (format-time-string "%Y/%m/") (my-make-slug (org-get-heading t t t t)) "/"))) (when (not (string= new-path (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME"))) (when (file-exists-p (expand-file-name (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") my-11ty-base-dir)) (rename-file (expand-file-name (org-entry-get (point) "EXPORT_ELEVENTY_FILE_NAME") my-11ty-base-dir) (expand-file-name new-path my-11ty-base-dir))) (org-entry-put (point) "EXPORT_ELEVENTY_PERMALINK" (concat "/" path)) (org-entry-put (point) "EXPORT_ELEVENTY_FILE_NAME" path)))) (defun my-11ty-convert-to-njk () (interactive) (let* ((filename (buffer-file-name)) (old-buffer (current-buffer)) (new-name (concat (file-name-base filename) ".njk"))) (save-buffer) (rename-file filename new-name) (find-file new-name) (kill-buffer old-buffer))) (defun my-11ty-browse-page () (interactive) (if (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK") (browse-url (concat "http://localhost:8080" (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK"))) (let* ((json-object-type 'plist) (data (json-read-file (concat (file-name-base (buffer-file-name)) ".11tydata.json")))) (browse-url (concat "http://localhost:8080" (plist-get data :permalink))) ))) (defun my-org-11ty-pathname () (if (derived-mode-p 'org-mode) (file-name-directory (org-entry-get-with-inheritance "EXPORT_ELEVENTY_FILE_NAME")) (let ((url (thing-at-point 'url))) (when url (url-file-directory (url-filename (url-generic-parse-url url))))))) (defun my-org-11ty-find-post (url) (interactive (list (my-org-11ty-pathname))) ;; check in posts.org (find-file "~/sync/orgzly/posts.org") (let ((pos (org-find-property "EXPORT_ELEVENTY_PERMALINK" url))) (when pos (goto-char pos)))) (defun my-org-11ty-find-file (file) (interactive (list (completing-read (if (my-org-11ty-pathname) (format "Post (%s): " (concat "/" (my-org-11ty-pathname))) "Post: ") (mapcar (lambda (o) (replace-regexp-in-string "^~/proj/static-blog\\|index.html$" "" o)) (directory-files-recursively "~/proj/static-blog/blog" "index\\.html" nil)) nil nil nil nil (concat "/" (my-org-11ty-pathname))))) (find-file (expand-file-name "index.html" (expand-file-name (concat "." file) "~/proj/static-blog")))) (defun my-org-11ty-post-to-mastodon (&optional post-automatically) (interactive (list current-prefix-arg)) (let ((message (concat (org-entry-get (point) "ITEM") " https://sachachua.com" (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK")))) (if post-automatically (my-mastodon-toot-public-string message) (mastodon-toot) (insert message)))) ;; https://kitchingroup.cheme.cmu.edu/blog/2013/05/05/Getting-keyword-options-in-org-files/ (defun my-org-keywords () "Parse the buffer and return a cons list of (property . value). This is extracted from lines like: #+PROPERTY: value" (org-element-map (org-element-parse-buffer 'element) 'keyword (lambda (keyword) (cons (org-element-property :key keyword) (org-element-property :value keyword))))) (defun my-11ty-copy-file-and-insert-into-org (filename caption) (interactive (list (read-file-name "File: ") (read-string "Caption: "))) (let ((path (expand-file-name (file-name-nondirectory filename) (expand-file-name (org-entry-get-with-inheritance "EXPORT_ELEVENTY_FILE_NAME") (assoc-default "ELEVENTY_BASE_DIR" (my-org-keywords))) ))) (copy-file filename path t) (insert "#+CAPTION: " caption "\n" (org-link-make-string (concat "file:" path)) "\n")))
(defun my-org-replace-with-permalink () (interactive) (let* ((elem (org-element-context)) (path (org-element-property :path elem)) (description (org-element-property :description elem)) (type (org-element-property :type elem)) (permalink (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK" t)) (base-url "https://sachachua.com")) (when (member type '("file" "audio" "video")) (delete-region (org-element-begin elem) (org-element-end elem)) (insert (org-link-make-string (concat (if (string= type "file") "" (concat type ":")) base-url permalink (file-name-nondirectory path) (if (string-match "\\?.+" path) (match-string 0 path) "")) description)))))
DONE Linking to blog topics
(defun my-org-topic-open (link &rest _) "Find the post." (if (string-match "\\(.*\\)#\\(.+\\)" link) (let ((file (match-string 1 link)) (anchor (match-string 2 link))) (find-file (format "~/sync/topics/%s.org" file)) (goto-char (org-find-property "CUSTOM_ID" anchor))) (find-file (format "~/sync/topics/%s.org" link)))) (defun my-org-topic-export (link desc format _) (let ((path (concat (if (eq format '11ty) "/" "https://sachachua.com/") "topic/" (replace-regexp-in-string "\\.html$" "/" (replace-regexp-in-string "^/\\|index.html$" "" (replace-regexp-in-string "^index" "" link)))))) (pcase format ((or 'html '11ty) (format "<a href=\"%s\">%s</a>" path (or desc link))) ('latex (format "\\href{%s}{%s}" path desc)) ('texinfo (format "@uref{%s,%s}" path desc)) ('ascii (if desc (format "%s (%s)" desc path) path))))) (defun my-org-topic-complete () (format "%stopic/%s/" my-blog-base-url (completing-read "Topic: " (mapcar (lambda (o) (file-name-base o)) (directory-files "~/sync/topics" "\\.org" nil))))) (org-link-set-parameters "topic" :follow #'my-org-topic-open :insert-description #'my-org-link-insert-description :export #'my-org-topic-export :complete #'my-org-topic-complete)
Linking to blog posts
- : added link description
(defvar my-blog-base-url "https://sachachua.com/") (defun my-org-blog-complete () (let ((base (replace-regexp-in-string "/$" "" my-blog-base-url))) (completing-read "Post: " (mapcar (lambda (o) (concat base (alist-get 'permalink o))) (let* ((json-object-type 'alist) (json-array-type 'list)) (json-read-file "~/sync/static-blog/_site/blog/all/index.json")))))) (defun my-org-blog-export (link desc format _) (let ((path (concat (if (eq format '11ty) "/" "https://sachachua.com/") (replace-regexp-in-string "\\.html$" "/" (replace-regexp-in-string "^/\\|index.html$" "" link))))) (pcase format ((or 'html '11ty) (format "<a href=\"%s\">%s</a>" path (or desc link))) ('latex (format "\\href{%s}{%s}" path desc)) ('texinfo (format "@uref{%s,%s}" path desc)) ('ascii (if desc (format "%s (%s)" desc path) path))))) (defun my-11ty-html-filename (link) "Return the HTML file for LINK." (setq link (replace-regexp-in-string "^blog:\\|https://sachachua.com/" "" link)) (if (file-exists-p link) link (or (catch 'found (dolist (f (list (expand-file-name "index.html" (expand-file-name (if (string-match "^/" link) (concat "." link) link) my-11ty-base-dir)) (expand-file-name "index.html" (expand-file-name (if (string-match "^/" link) (concat "." link) link) (expand-file-name "blog" my-11ty-base-dir))) (replace-regexp-in-string "/$" ".html" (expand-file-name (if (string-match "^/" link) (concat "." link) link) my-11ty-base-dir)) (replace-regexp-in-string "/$" ".html" (expand-file-name (if (string-match "^/" link) (concat "." link) link) my-11ty-base-dir)))) (if (and f (file-exists-p f)) (throw 'found f)))) (error "%s not found" link)))) (defun my-org-blog-open (link &rest _) "Find the post if it exists, or open the HTML." (with-current-buffer (find-file-noselect "~/sync/orgzly/posts.org") (let ((pos (org-find-property "EXPORT_ELEVENTY_PERMALINK" link))) (if pos (progn (goto-char pos) (switch-to-buffer (current-buffer))) (when-let ((filename (my-11ty-html-filename link))) (find-file filename)))))) (defun my-org-link-insert-description (link &optional description) (unless description (my-blog-title (my-org-link-as-url link)))) (defun my-org-store-blog-post-link () (when (and (derived-mode-p 'org-mode) (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK")) (let ((permalink (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK"))) (org-link-store-props :link (concat (replace-regexp-in-string "/$" "" my-blog-base-url) permalink) :description (save-excursion (goto-char (org-find-property "EXPORT_ELEVENTY_PERMALINK" permalink)) (org-entry-get (point) "ITEM")))))) (use-package org :config (org-link-set-parameters "blog" :follow #'my-org-blog-open :store #'my-org-store-blog-post-link :insert-description #'my-org-link-insert-description :export #'my-org-blog-export :complete #'my-org-blog-complete))
- DONE List all blog posts that match a category or title search
(defun my-11ty-list-all-matching-blog-posts (match) (interactive "MMatch: ") (mapc (lambda (o) (when (or (string-match match (alist-get 'title o)) (member match (alist-get 'categories o))) (insert "- " (org-link-make-string (concat my-blog-base-url (alist-get 'permalink o)) (alist-get 'title o)) "\n"))) (my-blog-posts)))
- Making it easier to add a category to a blog post
I want to be able to quickly add a category to a post when I'm looking at the file or when I'm working with a link.
(defun my-11ty-complete-blog-post () (completing-read "Post: " (mapcar (lambda (o) (file-name-directory (file-relative-name o my-11ty-base-dir))) (directory-files-recursively (expand-file-name "blog" my-11ty-base-dir) "index\\.html" nil)))) (defun my-11ty-ripgrep () (interactive) (consult-ripgrep (expand-file-name "blog" my-11ty-base-dir))) (defun my-11ty-post-categories (file) (assoc-default 'categories (let ((json-object-type 'alist) (json-array-type 'list)) (json-read-file (my-11ty-json-filename file))))) (defun my-11ty-add-category-tag (cat) (interactive (list (my-11ty-complete-category "Category: "))) (org-set-tags (cons cat (org-get-tags)))) (defun my-11ty-complete-category (prompt &optional categories) (let ((all-categories (json-read-file (expand-file-name "siteCategories.json" (expand-file-name "_data" my-11ty-base-dir))))) (completing-read (if categories (format "%s(current: %s) " prompt (string-join categories ", ")) prompt) (mapcar (lambda (c) (assoc-default 'slug c)) all-categories)))) (defun my-11ty-json-filename (path) (concat (file-name-sans-extension (my-11ty-html-filename path)) ".11tydata.json")) (defun my-11ty-change-details (file modify-func) (let* ((json-object-type 'alist) (json-array-type 'list) (json-file (my-11ty-json-filename file)) (json (funcall modify-func (json-read-file json-file)))) (when json (with-temp-file json-file (insert (json-encode json))) json-file))) (defun my-11ty-add-category-to-post (file new-category) (interactive (list (buffer-file-name) (my-11ty-complete-category "Add category: " (my-11ty-post-categories file)))) (my-11ty-change-details file (lambda (json) (let ((categories (assoc-default 'categories json))) (if categories (unless (member new-category categories) (setcdr (assoc 'categories json) (cons new-category categories))) (setq json (cons (cons 'categories (cons new-category categories)) json))) json))))
Then it makes sense to be able to work with blog URLs from an Embark action:
(defun my-embark-org-blog-target () "Identify when we're looking at a blog link." (cond ((and (derived-mode-p 'org-mode) (let ((context (org-element-context))) (and (org-element-type-p context 'link) (cond ((string= (org-element-property :type context) "blog") (cons 'my-blog (org-element-property :path (org-element-context)))) ((string-match "//sachachua.com\\(.+\\)" (org-element-property :path context)) (cons 'my-blog (match-string 1 (org-element-property :path context)))))))) ))) (defun my-embark-org-blog-add-category (blog &optional category) (interactive (list (my-org-blog-complete))) (unless category (setq category (my-11ty-complete-category "Add category: " (my-11ty-post-categories (my-11ty-html-filename blog))))) (my-11ty-add-category-to-post (my-11ty-html-filename blog) category)) (defun my-embark-org-blog-open-in-browser (path) (interactive (list (my-org-blog-complete))) (browse-url (concat "https://sachachua.com/" (replace-regexp-in-string "^\\(blog:\\)?/" "" path)))) (with-eval-after-load 'embark (add-to-list 'embark-target-finders #'my-embark-org-blog-target) (defvar-keymap embark-my-blog-actions :doc "Shortcuts for my blog" "h" #'my-blog-edit-html "j" #'my-blog-edit-json "e" #'my-embark-11ty-find-org "c" #'my-embark-org-blog-add-category "b" #'my-embark-org-blog-open-in-browser) (add-to-list 'embark-keymap-alist '(my-blog . embark-my-blog-actions)))
Then I want to be able to add a category to all the blog posts in a region:
(defun my-11ty-add-category-to-all-posts-in-region (category beg end) (interactive (list (my-11ty-complete-category "Category: ") (min (point) (mark)) (max (point) (mark)))) (goto-char beg) (while (re-search-forward org-link-bracket-re end t) (my-11ty-add-category-to-post (my-11ty-html-filename (org-element-property :raw-link (org-element-context))) category)))
embark-11ty 11ty org emacs
(defvar my-11ty-base-dir "~/proj/static-blog/") (defun my-embark-11ty-find-org (url) (interactive (list (my-complete-blog-post-url))) (setq url (my-org-link-as-url url)) (when (string-match "https://sachachua\\.com\\(/blog/.*\\)" url) (let ((path (match-string 1 url)) pos) ;; check my config (catch 'found (dolist (file '("~/sync/emacs/Sacha.org" "~/sync/orgzly/posts.org")) (with-current-buffer (find-file-noselect file) (setq pos (org-find-property "EXPORT_ELEVENTY_PERMALINK" path)) (when pos (switch-to-buffer (current-buffer)) (goto-char pos) (throw 'found (buffer-file-name))))) (when (file-exists-p (expand-file-name "index.org" (concat my-11ty-base-dir path))) (find-file (expand-file-name "index.org" (concat my-11ty-base-dir path))) (throw 'found (buffer-file-name))))))) (defun my-embark-11ty-find-html (url) (interactive (list (my-complete-blog-post-url))) (when (string-match "https://sachachua\\.com\\(/blog/.*\\)" (my-org-link-as-url url)) (let ((path (match-string 1 url)) pos) ;; check my config (catch 'found (dolist (file '("~/sync/emacs/Sacha.org" "~/sync/orgzly/posts.org")) (with-current-buffer (find-file-noselect file) (setq pos (org-find-property "EXPORT_ELEVENTY_PERMALINK" path)) (when pos (switch-to-buffer (current-buffer)) (goto-char pos) (throw 'found (buffer-file-name))))) (when (file-exists-p (expand-file-name "index.org" (concat my-11ty-base-dir path))) (find-file (expand-file-name "index.org" (concat my-11ty-base-dir path))) (throw 'found (buffer-file-name))))))) (with-eval-after-load 'embark (define-key embark-url-map "v" #'my-embark-11ty-find-org) (define-key embark-org-link-map "v" #'my-embark-11ty-find-org))
Moving my Org post subtree to the 11ty directory 11ty org emacs blogging
I sometimes want to move the Org source for my blog posts to the same directory as the 11ty-exported HTML. This should make it easier to update and reexport blog posts in the future. The following code copies or moves the subtree to the 11ty export directory.
(defun my-org-11ty-copy-subtree (&optional do-cut subtreep) "Copy the subtree for the current post to the 11ty export directory. With prefix arg, move the subtree." (interactive (list current-prefix-arg)) (let* ((info (org-combine-plists (org-export--get-export-attributes '11ty subtreep) (org-export--get-buffer-attributes) (org-export-get-environment '11ty subtreep))) (file-properties (seq-filter (lambda (entry) (string-match (regexp-opt '("ELEVENTY_COLLECTIONS" "ELEVENTY_BASE_DIR" "ELEVENTY_BASE_URL" "TITLE" "ELEVENTY_CATEGORIES" "ELEVENTY_LAYOUT")) (car entry))) (org-element-map (org-element-parse-buffer) 'keyword (lambda (el) (cons (org-element-property :key el) (org-element-property :value el)))))) (entry-properties (org-entry-properties)) (filename (expand-file-name "index.org" (expand-file-name (plist-get info :file-name) (plist-get info :base-dir)))) (parent-pos (org-find-property "EXPORT_ELEVENTY_FILE_NAME" (org-entry-get-with-inheritance "EXPORT_ELEVENTY_FILE_NAME"))) body) (unless (string= (buffer-file-name) filename) (unless (file-directory-p (file-name-directory filename)) (make-directory (file-name-directory filename) t)) ;; find the heading that sets the current EXPORT_ELEVENTY_FILE_NAME (if parent-pos (save-excursion (goto-char parent-pos) (org-copy-subtree 1 (if do-cut 'cut))) (setq body (buffer-string))) (with-temp-file filename (org-mode) (if subtreep (progn (insert (or (mapconcat (lambda (o) (format "#+%s: %s" (car o) (cdr o))) file-properties "\n") "") "\n") (org-yank)) (insert body))))))
Then this adds a link to it:
(defun my-org-export-filter-body-add-index-link (info) (when (and (plist-get info :file-name) (plist-get info :base-dir) (file-exists-p (expand-file-name "index.org" (expand-file-name (plist-get info :file-name) (plist-get info :base-dir))))) (goto-char (point-max)) (insert (format "<div><a href=\"%sindex.org\">View org source for this post</a></div>" (plist-get info :permalink))))) (with-eval-after-load 'ox-11ty (add-to-list 'org-11ty-process-export-functions #'my-org-export-filter-body-add-index-link))
Then I want to wrap the whole thing up in an export function:
(defun my-org-11ty-export (&optional async subtreep visible-only body-only ext-plist) (let* ((info (org-11ty--get-info subtreep visible-only)) (file (org-11ty--base-file-name subtreep visible-only))) (unless (string= (plist-get info :input-file) (expand-file-name "index.org" (expand-file-name (plist-get info :file-name) (plist-get info :base-dir)))) (save-window-excursion (my-org-11ty-copy-subtree nil subtreep))) (org-11ty-export-to-11tydata-and-html async subtreep visible-only body-only ext-plist) ;(my-org-11ty-find-file) ))
Now to figure out how to override the export menu. Totally messy hack!
(with-eval-after-load 'ox-11ty (map-put (caddr (org-export-backend-menu (org-export-get-backend '11ty))) ?1 (list "To Org, 11tydata.json, HTML" 'my-org-11ty-export)))
Cleaning up export
Timestamps and section numbers make my published files look more complicated than they are. Let's turn them off by default, and let's use fancy HTML5.
(setq org-html-doctype "html5") (setq org-html-html5-fancy t) (setq org-export-with-section-numbers nil) (setq org-html-include-timestamps nil) (setq org-export-with-sub-superscripts nil) (setq org-export-with-toc nil) (setq org-html-toplevel-hlevel 2) (setq org-export-htmlize-output-type 'css) (setq org-export-with-broken-links t) (setq org-ascii-text-width 10000) (setq-default tab-width 2)
This makes it easier to publish my files:
(defun my-org-11ty-publish-from-project (_ from-file _) (with-current-buffer (find-file-noselect from-file) (save-excursion (goto-char (point-min)) (when (save-excursion (re-search-forward "ELEVENTY_PERMALINK" nil t)) (my-org-11ty-export))))) (setq org-publish-project-alist '(("stream" :base-directory "~/proj/stream" ) ("emacs-config" :base-directory "~/.config/emacs" :publishing-directory "~/.config/emacs" :publishing-function my-org-html-publish-to-html-trustingly ) ("book-notes" :base-directory "c:/sacha/Dropbox/books" :publishing-directory "c:/sacha/Dropbox/books/html" :publishing-function my-org-html-publish-to-html-trustingly :makeindex t) ("topics" :base-directory "~/sync/topics" :publishing-directory "/tmp/topics" :publishing-function my-org-11ty-publish-from-project))) ;(load "~/proj/dev/emacs-chats/build-site.el" t) ;(load "~/proj/dev/emacs-notes/build-site.el" t)
If a file is in a publishing project, publish it.
(defun my-org-publish-maybe () (require 'ox-publish) (interactive) (save-excursion (if (org-publish-get-project-from-filename (buffer-file-name (buffer-base-buffer)) 'up) (org-publish-current-file t) (my-org-html-export-trustingly))))
Make it easy to publish and browse a file.
(defun my-org-publish-and-browse () (interactive) (save-buffer) (my-org-publish-maybe) (browse-url (org-export-output-file-name ".html" nil default-directory))) (bind-key "<apps> b" 'my-org-publish-and-browse)
Publish without prompting
I want to be able to export without having to say yes to code blocks all the time.
(defun my-org-html-export-trustingly () (interactive) (let ((org-confirm-babel-evaluate nil)) (org-html-export-to-html))) (defun my-org-html-publish-to-html-trustingly (plist filename pub-dir) (let ((org-confirm-babel-evaluate nil)) (org-html-publish-to-html plist filename pub-dir)))
Special blocks
(use-package org-special-block-extras :if my-laptop-p :hook (org-mode . org-special-block-extras-mode) :init (setq org-special-block-add-html-extra nil) :config ;; Use short names like ‘defblock’ instead of the fully qualified name ;; ‘org-special-block-extras--defblock’ (setcdr org-special-block-extras-mode-map nil) (org-defblock my_details (title "Details" title-color "Green" open "") "Top level (HTML & 11ty)OSPE-RESPECT-NEWLINES? Enclose contents in a folded up box." (message "my_details %s %s %s" title title-color open) (cond ((eq backend '11ty) (format "{%% details \"%s\" %s%%}\n%s\n{%% enddetails %%}" title (if (string= open "") "" ", \"open\"") contents)) ((eq backend 'html) (format "<details class=\"code-details\" style =\"padding: 1em; border-radius: 15px; font-size: 0.9em; box-shadow: 0.05em 0.1em 5px 0.01em #00000057;\"%s> <summary> <strong> <font face=\"Courier\" size=\"3\" color=\"%s\"> %s </font> </strong> </summary> %s </details>" (if (string= open "") "" " open") title-color title contents)))) (org-defblock columns nil nil "Top level (HTML & wp & 11ty)OSPE-RESPECT-NEWLINES? Split into columns using Foundation." (format "<div class=\"row\">%s</div>" contents)) (org-defblock column50 nil nil "Top level (HTML & wp & 11ty)OSPE-RESPECT-NEWLINES? Split into columns." (format "<div class=\"columns small-12 medium-6 large-6\">%s</div>" contents)) (org-defblock short (yt nil video nil audio nil thumbnail nil) "Top level (HTML & 11ty)OSPE-RESPECT-NEWLINES? Mark up a YouTube short." (let ((yt-link (and yt (format "<a href=\"https://youtube.com/watch?v=%s\">watch this on YouTube</a>" (my-org-yt-id yt)))) (video-link (and video (format "<a href=\"%s\">download the video</a>" (org-export-file-uri video)))) (audio-link (and audio (format "<a href=\"%s\">download the audio</a>" (org-export-file-uri audio))))) (concat "<div class=\"row\"><div class=\"columns\"><div style=\"width: 400px\">" (if video (my-org-video-export (concat "video:" (expand-file-name video) "?thumbnail=" (or thumbnail "")) nil backend nil) (my-org-yt-export yt nil backend nil)) "</div></div><div class=\"columns\">" contents "<p>You can " (cond ((and yt-link video-link audio-link) (format "%s, %s, or %s." yt-link video-link audio-link)) ((and yt-link video-link) (format "%s or %s." yt-link video-link)) ((and yt-link audio-link) (format "%s or %s." yt-link audio-link)) ((and video-link audio-link) (format "%s or %s." video-link audio-link)) (video-link (format "%s." video-link)) (audio-link (format "%s." audio-link))) "</p></div></div>"))) (org-defblock visual_book_note (title nil post nil image nil) "Top level (HTML & 11ty)OSPE-RESPECT-NEWLINES? Mark up a visual book note thumbnail." (format "<figure class=\"book\"> <a href=\"%s\"> <div><img src=\"%s\" alt=\"%s\" /></div> <figcaption>%s</figcaption> </a> </figure>" post image title title)) (org-defblock gallerylist () "Top level (HTML & 11ty)OSPE-RESPECT-NEWLINES? Mark up a visual book note thumbnail." (if (eq backend '11ty) (concat "{% gallerylist %}\n" contents "\n{% endgallerylist %}\n") (concat "<div class=\"gallerylist\">" contents "</div>"))))
And here's a little thing to convert a two-level list into my collapsible sections:
(defun my-org-convert-list-to-collapsible-details () (interactive) (let ((list (org-list-to-lisp t))) (mapc (lambda (o) (when (stringp (car o)) (insert (format "#+begin_my_details %s :open t\n%s#+end_my_details\n" (car o) (mapconcat (lambda (s) (concat "- " (string-trim (org-ascii--indent-string (car s) 2)) "\n")) (cdr (cadr o))))))) (cdr list))))
Adding a custom header argument to Org Mode source blocks and using that argument during export org emacs
I sometimes want to put long source blocks in a
<details><summary>...</summary>...</details>
block when I export to
HTML, so that they're tucked away in a collapsible block. I tried
using https://github.com/alhassy/org-special-block-extras
to define
my own #+begin_my_details "summary text" ... #+end_my_details
block,
but source blocks inside my_details
doesn't get fontlocked properly
while in the Org file. I wanted to add a :summary
attribute to the
regular src blocks, and to change the HTML export to wrap the code in
details
if the summary was specified.
Code for adding a :summary argument and using it during export
(setq org-babel-exp-code-template "#+begin_src %lang%switches%flags :summary %summary\n%body\n#+end_src") (defun my-org-html-src-block (src-block _contents info) (let* ((result (org-html-src-block src-block _contents info)) (block-info (org-with-point-at (org-element-property :begin src-block) (org-babel-get-src-block-info))) (summary (assoc-default :summary (elt block-info 2)))) (if (member summary '("%summary" "")) result (format "<details><summary>%s</summary>%s</details>" summary result)))) (defun my-org-11ty-src-block (src-block _contents info) (let* ((result (org-11ty-src-block src-block _contents info)) (block-info (org-with-point-at (org-element-property :begin src-block) (org-babel-get-src-block-info))) (summary (assoc-default :summary (elt block-info 2)))) (if (member summary '("%summary" "")) result (format "<details><summary>%s</summary>%s</details>" summary result)))) (with-eval-after-load 'ox-html (map-put! (org-export-backend-transcoders (org-export-get-backend 'html)) 'src-block 'my-org-html-src-block)) (with-eval-after-load 'ox-11ty (map-put! (org-export-backend-transcoders (org-export-get-backend '11ty)) 'src-block 'my-org-11ty-src-block))
So now I can use it by specifying blocks like this:
#+begin_src emacs-lisp :summary "Code for adding a :summary argument and using it during export" ;; code goes here #+end_src
It took me a bit of digging around to figure this out. When I added
the :summary
attribute, org-babel-get-src-block-info
found it when
I was in the Org file, but by the time my-org-html-src-block
was
called, the block had been replaced with a copy that didn't have the
header argument. I dug around using edebug's d
command for
displaying the backtrace, stepping through various functions. I found
out that in the process for exporting source code blocks,
org-babel-exp-code
replaces the source block with the value of
org-babel-exp-code-template
, substituting certain values. Adding the
summary
flag to that and retrieving the summary information using
org-babel-get-src-block-info
worked. I originally used advice-add
to override org-html-src-block
, but I think I'll try replacing the
transcoder.
Adding custom header arguments could be useful for different export-related tweaks (someone wanted to create an argument for highlighting certain lines but hadn't figured it out in that thread). If there's a more elegant way to do this, I'd love to find out!
Stylesheet / header
Might as well take advantage of my stylesheet:
(setq org-html-head " <link rel=\"stylesheet\" type=\"text/css\" href=\"https://sachachua.com/assets/css/style.css\"></link> <link rel=\"stylesheet\" type=\"text/css\" href=\"https://sachachua.com/assets/css/org-export.css\"></link> <script src=\"https://ajax.googleapis.com/ajax/libs/jquery/1.11.0/jquery.min.js\"></script> <script src=\"https://sachachua.com/assets/js/misc.js\"></script>") (setq org-html-htmlize-output-type 'css) (setq org-src-fontify-natively t)
Copy region
Sometimes I want a region's HTML in my kill-ring/clipboard without any of the extra fluff:
(defun my-org-copy-region-as-html (beg end &optional level) "Make it easier to copy code for Wordpress posts and other things." (interactive "r\np") (let ((org-export-html-preamble nil) (org-html-toplevel-hlevel (or level 3))) (kill-new (org-export-string-as (buffer-substring beg end) 'html t))))
Sometimes I want a subtree:
(defun my-org-copy-subtree-as-html () (interactive) (my-org-copy-region-as-html (org-back-to-heading) (org-end-of-subtree)))
UTF-8 checkboxes
This snippet turns - [X]
into ☑ and - [ ]
into ☐, but leaves [-]
alone.
(setq org-html-checkbox-type 'unicode) (setq org-html-checkbox-types '((unicode (on . "<span class=\"task-done\">☑</span>") (off . "<span class=\"task-todo\">☐</span>") (trans . "<span class=\"task-in-progress\">[-]</span>"))))
Beamer
(with-eval-after-load 'org (require 'ox-latex) (add-to-list 'org-latex-classes '("beamer" "\\documentclass\[presentation\]\{beamer\}" ("\\section\{%s\}" . "\\section*\{%s\}") ("\\subsection\{%s\}" . "\\subsection*\{%s\}") ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))) (add-to-list 'org-latex-classes '("memoir" "\\documentclass\{memoir\}" ("\\section\{%s\}" . "\\section*\{%s\}") ("\\subsection\{%s\}" . "\\subsection*\{%s\}") ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))))
PlantUML
(setq org-plantuml-jar-path (expand-file-name "/usr/share/plantuml/plantuml.jar")) (add-to-list 'org-src-lang-modes '("plantuml" . plantuml))
ox-hugo
(use-package ox-hugo :ensure t ;Auto-install the package from Melpa (optional) :after ox)
Org Mode: Asynchronous export and tangle of a large file org
I have a pretty large Emacs configuration file. It's annoying to wait
11 seconds for it to export to HTML or 12 seconds to tangle.
Fortunately, Org Mode allows me to export asynchronously. I tried it
out from org-export-dispatch
(C-c C-e
) by using the C-a
option.
It worked pretty well, but it was a bit slow because it loaded my full
configuration. Fortunately, there's a way to use a smaller
configuration that focuses on just the packages needed.
(setq org-export-async-init-file "~/.config/emacs/org-async-export-config.el") (setq org-export-async-debug t)
I've named the source blocks, and this block assembles the config from those named blocks by using noweb.
<<org-async-variables>> <<startup>> <<system-info>> <<package-setup>> <<org-package-setup>> (require 'ol) <<org-babel-default-header-args>> <<org-styles>> <<org-special-blocks>> <<org-clean-up-export>> <<org-my-include-link>> <<org-blog-link>> <<org-dotemacs-link>> <<org-yt-link>> <<org-video-link>> <<org-audio-link>> <<org-captions-link>> <<org-project-link>> <<org-elisp-link>> <<org-irc-link>> <<org-protocol-link>> <<org-journal-link>> <<org-package-link>> <<org-defun-link>> <<org-defvar-link>> <<my-mastodon-store-link>> <<org-sketch-link>> <<org-copy-link>> <<org-config-link>>
I want my config file to be tangled and exported to HTML regularly so that I don't forget to do so. The following code exports my config, but only if I saved it myself instead of when I auto-save it by focusing away from Emacs.
(defmacro my-org-debounce-idle-timer (seconds var body &rest args) `(progn (defvar ,var nil "Timer.") (when (timerp ,var) (cancel-timer ,var)) (setq ,var (run-with-idle-timer ,seconds nil ,body ,@args)))) (defvar my-unfocusing nil "Non-nil when I'm in the middle of unfocusing.") (defun my-org-async-export-and-tangle (&optional filename) (async-start `(lambda () ;; make async emacs aware of packages (for byte-compilation) (package-initialize) (setq package-enable-at-startup nil) (require 'org) (setq-default tab-width 2) (setq org-babel-default-header-args '((:session . "none") (:results . "drawer replace") (:comments . "link") (:exports . "code") (:cache . "no") (:eval . "never-export") (:hlines . "no") (:tangle . "no"))) (setq org-edit-src-auto-save-idle-delay 5) (org-babel-tangle-file ,(buffer-file-name)) ) (lambda (&rest results) (message "Tangled."))) (org-export-to-file 'html (or filename "index.html") t)) (defun my-org-export-and-tangle-if-saved-in-focus () (interactive) (when (frame-focus-state) (message "Scheduling export...") (my-org-debounce-idle-timer 10 my-export-org-config (lambda (buf) (with-current-buffer buf (my-org-async-export-and-tangle "index.html"))) (current-buffer)))) (define-minor-mode my-org-export-and-tangle-when-saved-in-focus-mode "Toggle a mode for exporting and tangling when saved. Interactively with no argument, this command toggles the mode. A positive prefix argument enables the mode, any other prefix argument disables it. From Lisp, argument omitted or nil enables the mode, `toggle' toggles the state." :group 'my (if my-org-export-and-tangle-when-saved-in-focus-mode (add-hook 'after-save-hook #'my-org-export-and-tangle-if-saved-in-focus nil t) (remove-hook 'after-save-hook #'my-org-export-and-tangle-if-saved-in-focus t))) (defun my-org-save-and-tangle-my-config () (when (string= (buffer-file-name) (expand-file-name "~/sync/emacs/Sacha.org")) (my-org-export-and-tangle-when-saved-in-focus-mode 1))) (defun my-export-dotemacs () (interactive) (org-export-to-file 'html "index.html")) ;(use-package org ; :hook ((org-mode . my-org-save-and-tangle-my-config)))
Let's see if this makes it easier for me to tweak things.
https://so.nwalsh.com/2020/01/05-latex , but I use letter paper instead of A4.
(setq org-latex-compiler "xelatex") (setq org-latex-pdf-process (list (concat "latexmk -" org-latex-compiler " -recorder -synctex=1 -bibtex-cond %b"))) (setq org-latex-default-packages-alist '(("" "graphicx" t) ("" "grffile" t) ("" "longtable" nil) ("" "wrapfig" nil) ("" "rotating" nil) ("normalem" "ulem" t) ("" "amsmath" t) ("" "textcomp" t) ("" "amssymb" t) ("" "capt-of" nil) ("" "hyperref" nil))) (setq org-latex-classes '(("article" "\\RequirePackage{fix-cm} \\PassOptionsToPackage{svgnames}{xcolor} \\documentclass[11pt]{article} \\usepackage{fontspec} \\setmainfont{Noto Sans} \\setsansfont[Scale=MatchLowercase]{Noto Sans} \\setmonofont[Scale=MatchLowercase]{Hack} \\usepackage{sectsty} \\allsectionsfont{\\sffamily} \\usepackage{enumitem} \\setlist[description]{style=unboxed,font=\\sffamily\\bfseries} \\usepackage{listings} \\lstset{frame=single,aboveskip=1em, framesep=.5em,backgroundcolor=\\color{AliceBlue}, rulecolor=\\color{LightSteelBlue},framerule=1pt} \\usepackage{xcolor} \\newcommand\\basicdefault[1]{\\scriptsize\\color{Black}\\ttfamily#1} \\lstset{basicstyle=\\basicdefault{\\spaceskip1em}} \\lstset{literate= {§}{{\\S}}1 {©}{{\\raisebox{.125ex}{\\copyright}\\enspace}}1 {«}{{\\guillemotleft}}1 {»}{{\\guillemotright}}1 {Á}{{\\'A}}1 {Ä}{{\\\"A}}1 {É}{{\\'E}}1 {Í}{{\\'I}}1 {Ó}{{\\'O}}1 {Ö}{{\\\"O}}1 {Ú}{{\\'U}}1 {Ü}{{\\\"U}}1 {ß}{{\\ss}}2 {à}{{\\`a}}1 {á}{{\\'a}}1 {ä}{{\\\"a}}1 {é}{{\\'e}}1 {í}{{\\'i}}1 {ó}{{\\'o}}1 {ö}{{\\\"o}}1 {ú}{{\\'u}}1 {ü}{{\\\"u}}1 {¹}{{\\textsuperscript1}}1 {²}{{\\textsuperscript2}}1 {³}{{\\textsuperscript3}}1 {ı}{{\\i}}1 {—}{{---}}1 {’}{{'}}1 {…}{{\\dots}}1 {⮠}{{$\\hookleftarrow$}}1 {␣}{{\\textvisiblespace}}1, keywordstyle=\\color{DarkGreen}\\bfseries, identifierstyle=\\color{DarkRed}, commentstyle=\\color{Gray}\\upshape, stringstyle=\\color{DarkBlue}\\upshape, emphstyle=\\color{Chocolate}\\upshape, showstringspaces=false, columns=fullflexible, keepspaces=true} \\usepackage[margin=1in,left=1.5in]{geometry} \\usepackage{parskip} \\makeatletter \\renewcommand{\\maketitle}{% \\begingroup\\parindent0pt \\sffamily \\Huge{\\bfseries\\@title}\\par\\bigskip \\LARGE{\\bfseries\\@author}\\par\\medskip \\normalsize\\@date\\par\\bigskip \\endgroup\\@afterindentfalse\\@afterheading} \\makeatother [DEFAULT-PACKAGES] \\hypersetup{linkcolor=Blue,urlcolor=DarkBlue, citecolor=DarkRed,colorlinks=true} \\AtBeginDocument{\\renewcommand{\\UrlFont}{\\ttfamily}} [PACKAGES] [EXTRA]" ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}") ("\\paragraph{%s}" . "\\paragraph*{%s}") ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) ("report" "\\documentclass[11pt]{report}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) ("book" "\\documentclass[11pt]{book}" ("\\part{%s}" . "\\part*{%s}") ("\\chapter{%s}" . "\\chapter*{%s}") ("\\section{%s}" . "\\section*{%s}") ("\\subsection{%s}" . "\\subsection*{%s}") ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))))
Org roam
(use-package org-roam :if my-laptop-p :ensure t :config (org-roam-db-autosync-mode) :hook (after-init . org-roam-mode) :custom (org-roam-directory "/home/sacha/sync/topics") :bind (:map org-roam-mode-map (("C-c n l" . org-roam) ("C-c n f" . org-roam-find-file) ("C-c n g" . org-roam-graph)) :map org-mode-map (("C-c n i" . org-roam-insert)) (("C-c n I" . org-roam-insert-immediate))))
Links
IDs
(setq org-id-method 'ts) (setq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id)
Quick links
(setq org-link-abbrev-alist '(("google" . "http://www.google.com/search?q=") ("gmap" . "http://maps.google.com/maps?q=%s") ))
Tag links
From http://endlessparentheses.com/use-org-mode-links-for-absolutely-anything.html?source=rss
(org-add-link-type "tag" 'endless/follow-tag-link)
(defun endless/follow-tag-link (tag) "Display a list of TODO headlines with tag TAG. With prefix argument, also display headlines without a TODO keyword." (org-tags-view (null current-prefix-arg) tag))
Links to my config
(defun my-org-dotemacs-export (path desc format _) "Export dotemacs link." (pcase format ((or 'html '11ty 'md) (format "<a href=\"https://sachachua.com/dotemacs#%s\">%s</a>" path (or desc path))) ('ascii desc))) (defun my-org-dotemacs-complete () "Prompt for dotemacs." (interactive) (with-current-buffer (find-file-noselect "~/sync/emacs/Sacha.org") (concat "dotemacs:" (org-read-property-value "CUSTOM_ID")))) (defun my-org-dotemacs-insert-description (link &optional description) (unless description (with-current-buffer (find-file-noselect "~/sync/emacs/Sacha.org") (save-restriction (widen) (org-entry-get (org-find-property "CUSTOM_ID" link) "ITEM"))))) (defun my-org-dotemacs-open (path) (with-current-buffer (find-file-noselect "~/sync/emacs/Sacha.org") (when-let ((pos (org-find-property "CUSTOM_ID" path))) (switch-to-buffer (current-buffer)) (goto-char pos)))) (defun my-org-dotemacs-store () (when (and (string= (buffer-file-name) (expand-file-name "~/sync/emacs/Sacha.org")) (org-entry-get (point) "CUSTOM_ID")) (org-link-store-props :link (concat "dotemacs:" (org-entry-get (point) "CUSTOM_ID")) :description (org-entry-get (point) "ITEM")))) (org-link-set-parameters "dotemacs" :complete #'my-org-dotemacs-complete :store #'my-org-dotemacs-store :insert-description #'my-org-dotemacs-insert-description :export #'my-org-dotemacs-export :follow #'my-org-dotemacs-open)
TODO add dotemacs completion
YouTube
(defvar my-org-yt-iframe-format (concat "<div class=\"yt-video\"><iframe width=\"456\"" " height=\"315\"" " title=""YouTube video player\"" " src=\"https://www.youtube-nocookie.com/embed/%s?enablejsapi=1\"" " frameborder=\"0\"" " allowfullscreen>%s</iframe><a href=\"%s\">Watch on YouTube</a></div>")) (defun my-org-yt-id (path) (cond ((string-match "\\(?:v=\\|tu\\.be/\\|live/\\)\\([^&]+\\)" path) (match-string 1 path)) ((string-match "\\(live_stream\\?channel.*\\)" path) (match-string 1 path)) (t path))) (defun my-org-yt-export (path desc format _) "Export time link or embed." (pcase format ((or 'html '11ty 'md) (cond (desc (format "<a href=\"%s\">%s</a>" path (or desc path))) (t (let* ((path-and-query (url-path-and-query (url-generic-parse-url path))) (url (car path-and-query)) (params (url-parse-query-string (cdr path-and-query))) (id (cond ((string-match "\\(?:v=\\|tu\\.be/\\|live/\\)\\([^&]+\\)" path) (match-string 1 path)) ((string-match "\\(live_stream\\?channel.*\\)" path) (match-string 1 path)) (t path))) (width (or (car (assoc-default "width" params 'string=)) "456")) (height (or (car (assoc-default "height" params 'string=)) "315")) (time (assoc-default "t" params 'string=))) (if time (format "<a href=\"%s\">%s</a>" path (or desc path)) (format "<div class=\"yt-video\"><iframe width=\"%s\" height=\"%s\" title=\"YouTube video player\" src=\"https://www.youtube-nocookie.com/embed/%s?enablejsapi=1\" frameborder=\"0\" allowfullscreen>%s</iframe><a href=\"%s\">Watch on YouTube</a></div>" width height id desc path)))))) ('ascii desc))) (defun my-org-yt-convert-time (time) (let ((split-time (reverse (split-string time ":")))) (format "%sh%sm%ss" (or (elt split-time 2) "0") (or (elt split-time 1) "0") (or (elt split-time 0) "0")))) (ert-deftest my-org-yt-convert-time () (should (string= (my-org-yt-convert-time "1:02") "0h1m02s"))) (defun my-org-yt-complete () "Prompt for a timestamp and link to a video." (interactive) (let* ((url (read-string "URL: " (when (derived-mode-p 'org-mode) (org-entry-get (point) "YOUTUBE")))) (time (read-string "Time: ")) (split-time (reverse (split-string time ":")))) (concat "yt:" url (if (string= time "") "" (concat (if (string-match "\\?" url) "&t=" "?t=") (format "%sh%sm%ss" (or (elt split-time 2) "0") (or (elt split-time 1) "0") (or (elt split-time 0) "0"))))))) (defun my-org-yt-insert-description (link &optional description) (unless description (when (string-match "t=\\([0-9hms]+\\)" link) (let ((split-time (cdr (reverse (split-string (match-string 1 link) "[hms]"))))) (concat (if (and (elt split-time 2) (not (string= (elt split-time 2) "0"))) (concat (elt split-time 2) ":") "") (if (elt split-time 1) (concat (if (and (and (elt split-time 2) (not (string= (elt split-time 2) "0"))) (< (length (elt split-time 1)) 2)) "0" "") (elt split-time 1) ":") "") (concat (if (and (elt split-time 1) (< (length (elt split-time 0)) 2)) "0" "") (elt split-time 0))))))) (ert-deftest my-org-yt-insert-description () (should (string= (my-org-yt-insert-description "yt:somevideo?t=0h1m2s") "1:02")) (should (string= (my-org-yt-insert-description "yt:somevideo?t=1h2m3s") "1:02:03"))) (defun my-org-yt-open (path) (browse-url path)) (org-link-set-parameters "yt" :complete #'my-org-yt-complete :insert-description #'my-org-yt-insert-description :export #'my-org-yt-export :follow #'my-org-yt-open) (defun my-org-copy-region-as-plain-text (beg end) "Copy as plain text, removing links." (interactive "r") (save-restriction (narrow-to-region beg end) (kill-new (org-export-as 'ascii nil nil t))))
Videos
(org-link-set-parameters "video" :export #'my-org-video-export :follow #'my-org-video-follow :complete #'my-org-video-complete) (defun my-org-video-follow (path _) (cond ((string-match "\\(https://.+\\):\\([0-9:]+\\)" path) (mpv-start (concat (match-string 1 path) "?t=" (my-org-yt-convert-time (match-string 2 path))))) ((string-match "https:" path) (mpv-start path)) ((string-match "\\(.+?\\):\\([0-9:]+\\)" path) (mpv-start (expand-file-name (match-string 1 path)) (concat "--start=+" (match-string 2 path)))) (t (mpv-play (expand-file-name (replace-regexp-in-string "\\?.*" "" path)))))) (defun my-org-video-replace-with-permalink () (interactive) (let* ((elem (org-element-context)) (path (org-element-property :path elem)) (description (org-element-property :description elem)) (permalink (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK" t))) (delete-region (org-element-begin elem) (org-element-end elem)) (insert (org-link-make-string (concat "video:https://sachachua.com" permalink (file-name-nondirectory path)) description)))) (defun my-org-video-export (link desc format info) "Export PATH to FORMAT using the specified wrap parameter." (if desc (org-export-string-as (org-link-make-string link desc) format) (pcase format ((or 'html '11ty 'md) (let* ((path-and-query (url-path-and-query (url-generic-parse-url link))) (params (and (cdr path-and-query) (url-parse-query-string (cdr path-and-query)))) body) (setq body (format "<video%s%s src=\"%s\" %stype=\"%s\">%s%s<a href=\"%s\">Download the video</a>%s</video>" (if (string= (or (car (assoc-default "controls" params 'string= '("1"))) "1") "0") "" " controls=\"1\"") (if (string= (or (car (assoc-default "autoplay" params 'string= '("0"))) "0") "0") "" " autoplay=\"1\"") (car path-and-query) (if (assoc-default "thumbnail" params) (format "poster=\"%s\" " (car (assoc-default "thumbnail" params))) "") (mailcap-file-name-to-mime-type (car path-and-query)) (if (assoc-default "captions" params) (format "<track kind=\"subtitles\" label=\"Captions\" src=\"%s\" srclang=\"en\" default></track>" (expand-file-name (car (assoc-default "captions" params)))) "") (if (assoc-default "thumbnail" params) (format "<div>Video not supported. Thumbnail:<br /><img src=\"%s\" alt=\"Thumbnail\" /></div>" (car (assoc-default "thumbnail" params))) "") (car path-and-query) (if (assoc-default "captions-below" params) "<div class=\"captions\" style=\"display: none\"></div>" "") )) (when (assoc-default "caption" params) (setq body (format "<figure>%s<figcaption><div>%s</div></figcaption></figure>" body (car (assoc-default "caption" params))))) body)) (_ link)))) (defun my-org-video-complete () "Complete video reference." (interactive) (concat "video:" (read-file-name "File: ")))
Audio
(org-link-set-parameters "audio" :export #'my-org-audio-export :complete #'my-org-audio-complete) (defun my-org-audio-replace-with-permalink () (interactive) (let* ((elem (org-element-context)) (path (org-element-property :path elem)) (description (org-element-property :description elem)) (permalink (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK" t))) (delete-region (org-element-begin elem) (org-element-end elem)) (insert (org-link-make-string (concat "audio:https://sachachua.com" permalink (file-name-nondirectory path)) description)))) (defun my-org-audio-export (link desc format _) "Export PATH to FORMAT using the specified wrap parameter." (if desc (org-export-string-as (org-link-make-string link desc) format) (pcase format ((or 'html '11ty 'md) (let* ((path-and-query (url-path-and-query (url-generic-parse-url link))) (params (and (cdr path-and-query) (url-parse-query-string (cdr path-and-query)))) (element (or (assoc-default "element" params #'string=) "audio"))) (format "<div class=\"audio\"><%s%s%s%s preload=\"metadata\" src=\"%s\" type=\"%s\"><a href=\"%s\">Download the audio</a>%s</%s>%s</div>" element (if (string= (or (assoc-default "controls" params 'string= "1") "1") "0") "" " controls=\"1\"") (if (string= (or (assoc-default "autoplay" params 'string= "0") "0") "0") "" " autoplay=\"1\"") (if (assoc-default "id" params) (format " id=\"%s\"" (car (assoc-default "id" params))) "") (car path-and-query) (mailcap-file-name-to-mime-type (car path-and-query)) (car path-and-query) (if (assoc-default "captions" params) (format "<track kind=\"captions\" label=\"Captions\" src=\"%s\" srclang=\"en\" default></track>" (car (assoc-default "captions" params))) "") element (if (and (assoc-default "captions" params) (assoc-default "id" params)) (format "<div class=\"captions\" style=\"display: none\"></div>" (car (assoc-default "id" params))) "") ))) (_ path)))) (ert-deftest my-org-audio-export () (should (string-match "<audio controls=\"1\" id=\"play-this\" src=\"test.opus\" type=\"audio/ogg\"><a href=\"test.opus\">Download the audio</a><track kind=\"subtitles\" label=\"Captions\" src=\"test.vtt\" srclang=\"en\" default></track></audio>" (my-org-audio-export "test.opus?id=play-this&captions=test.vtt" nil 'html nil ) ))) (defun my-org-audio-complete () "Complete audio reference." (interactive) (concat "audio:" (read-file-name "File: ")))
Using an Emacs Lisp macro to define quick custom Org Mode links to project files; plus URLs and search org emacs coding
C-. r
(my-embark-replace-link-with-exported-url
)
: Added function for replacing current link, bound to - Added embark action to copy the exported link URL.
- Switched to using Github links since Codeberg's down.
- Updated my-copy-link to just return the link if called from Emacs Lisp. Fix getting the properties.
embark-around-action-hooks
Add tip from Omar about consult--grep-position
Simplify code by using
Summary (882 words): Emacs macros make it easy to define sets of related functions for custom Org links. This makes it easier to link to projects and export or copy the links to the files in the web-based repos. You can also use that information to consult-ripgrep across lots of projects.
I'd like to get better at writing notes while coding and at turning
those notes into blog posts and videos. I want to be able to link to
files in projects easily with the ability to complete, follow, and
export links. For example, [[subed:subed.el]]
should become
subed.el, which opens the file if I'm in Emacs and exports a
link if I'm publishing a post. I've been making custom link types
using org-link-set-parameters
. I think it's time to make a macro
that defines that set of functions for me. Emacs Lisp macros are a
great way to write code to write code.
(defvar my-project-web-base-list nil "Local path . web repo URLs for easy linking.") (defmacro my-org-project-link (type file-path git-url) `(progn (defun ,(intern (format "my-org-%s-complete" type)) () ,(format "Complete a file from %s." type) (concat ,type ":" (completing-read "File: " (projectile-project-files ,file-path)))) (defun ,(intern (format "my-org-%s-follow" type)) (link _) ,(format "Open a file from %s." type) (find-file (expand-file-name link ,file-path))) (defun ,(intern (format "my-org-%s-export" type)) (link desc format _) "Export link to file." (setq desc (or desc link)) (when ,git-url (setq link (concat ,git-url (replace-regexp-in-string "^/" "" link)))) (pcase format ((or 'html '11ty) (format "<a href=\"%s\">%s</a>" link (or desc link))) ('md (if desc (format "[%s](%s)" desc link) (format "<%s>" link))) ('latex (format "\\href{%s}{%s}" link desc)) ('texinfo (format "@uref{%s,%s}" link desc)) ('ascii (format "%s (%s)" desc link)) (_ (format "%s (%s)" desc link)))) (with-eval-after-load 'org (org-link-set-parameters ,type :complete (quote ,(intern (format "my-org-%s-complete" type))) :export (quote ,(intern (format "my-org-%s-export" type))) :follow (quote ,(intern (format "my-org-%s-follow" type)))) (cl-pushnew (cons (expand-file-name ,file-path) ,git-url) my-project-web-base-list :test 'equal))))
Then I can define projects this way:
(my-org-project-link "subed" "~/proj/subed/subed/" "https://github.com/sachac/subed/blob/main/subed/" ;; "https://codeberg.org/sachac/subed/src/branch/main/subed/" ) (my-org-project-link "emacsconf-el" "~/proj/emacsconf/lisp/" "https://git.emacsconf.org/emacsconf-el/tree/") (my-org-project-link "subed-record" "~/proj/subed-record/" "https://github.com/sachac/subed-record/blob/main/" ;; "https://codeberg.org/sachac/subed-record/src/branch/main/" ) (my-org-project-link "compile-media" "~/proj/compile-media/" "https://github.com/sachac/compile-media/blob/main/" ;; "https://codeberg.org/sachac/compile-media/src/branch/main/" ) (my-org-project-link "ox-11ty" "~/proj/ox-11ty/" "https://github.com/sachac/ox-11ty/blob/master/")
And I can complete them with the usual C-c C-l
(org-insert-link
) process:
Sketches are handled by my Org Mode sketch links, but we can add them anyway.
(cl-pushnew (cons (expand-file-name "~/sync/sketches/") "https://sketches.sachachua.com/filename/") my-project-web-base-list :test 'equal)
I've been really liking being able to refer to various emacsconf-el files by just selecting the link type and completing the filename, so maybe it'll be easier to write about lots of other stuff if I extend that to my other projects.
Copy web link
- : Fix Wayback link handling.
- : Add Wayback machine.
Keeping a list of projects and their web versions also makes it easier
for me to get the URL for something. I try to post as much as possible
on the Web so that it's easier for me to find things again and so that
other people can pick up ideas from my notes. Things are a bit
scattered: my blog, repositories on Github and Codeberg, my
sketches… I don't want to think about where the code has ended
up, I just want to grab the URL. If I'm going to put the link into an
Org Mode document, that's super easy. I just take advantage of the
things I've added to org-store-link
. If I'm going to put it into an
e-mail or a toot or wherever else, I just want the bare URL.
I can think of two ways to approach this. One is a command that copies just the URL by figuring it out from the buffer filename, which allows me to special-case a bunch of things:
(defun my-copy-link (&optional filename skip-links) "Return the URL of this file. If FILENAME is non-nil, use that instead. If SKIP-LINKS is non-nil, skip custom links. If we're in a Dired buffer, use the file at point." (interactive) (setq filename (or filename (if (derived-mode-p 'dired-mode) (dired-get-filename)) (buffer-file-name))) (if-let* ((project-re (concat "\\(" (regexp-opt (mapcar 'car my-project-web-base-list)) "\\)" "\\(.*\\)")) (url (cond ((and (derived-mode-p 'org-mode) (eq (org-element-type (org-element-context)) 'link) (not skip-links)) (pcase (org-element-property :type (org-element-context)) ((or "https" "http") (org-element-property :raw-link (org-element-context))) ("yt" (org-element-property :path (org-element-context))) ;; if it's a custom link, visit it and get the link (_ (save-window-excursion (org-open-at-point) (my-copy-link nil t))))) ;; links to my config usually have a CUSTOM_ID property ((string= (buffer-file-name) (expand-file-name "~/sync/emacs/Sacha.org")) (concat "https://sachachua.com/dotemacs#" (org-entry-get-with-inheritance "CUSTOM_ID"))) ;; blog post drafts have permalinks ((and (derived-mode-p 'org-mode) (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK")) (concat "https://sachachua.com" (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK"))) ;; some projects have web repos ((string-match project-re filename) (concat (assoc-default (match-string 1 filename) my-project-web-base-list) (url-hexify-string (match-string 2 filename))))))) (progn (when (called-interactively-p 'any) (kill-new url) (message "%s" url)) url) (error "Couldn't figure out URL.")))
Another approach is to hitch a ride on the Org Mode link storage and
export functions and just grab the URL from whatever link I've stored
with org-store-link
, which I've bound to C-c l
. I almost always
have an HTML version of the exported link. We can even use XML parsing
instead of regular expressions.
(defun my-org-link-as-url (link) "Return the final URL for LINK." (cond ((string-match "^/" link) (concat my-blog-base-url (replace-regexp-in-string "^/" "" link))) ((string-match "^https://" link) link) (t (dom-attr (dom-by-tag (with-temp-buffer (insert (org-export-string-as link 'html t)) (xml-parse-region (point-min) (point-max))) 'a) 'href)))) (defun my-org-stored-link-as-url (&optional link insert) "Copy the stored link as a plain URL. If LINK is specified, use that instead." (interactive (list nil current-prefix-arg)) (setq link (or link (caar org-stored-links))) (let ((url (if link (my-org-link-as-url link) (error "No stored link")))) (when (called-interactively-p 'any) (if url (if insert (insert url) (kill-new url)) (error "Could not find URL."))) url)) (ert-deftest my-org-stored-link-as-url () (should (string= (my-org-stored-link-as-url "[[dotemacs:web-link]]") "https://sachachua.com/dotemacs#web-link")) (should (string= (my-org-stored-link-as-url "[[dotemacs:org-mode-sketch-links][my Org Mode sketch links]]") "https://sachachua.com/dotemacs#org-mode-sketch-links"))) (defun my-embark-org-copy-exported-url-as-wayback (link &rest _) (interactive "MLink: ") (let ((url (my-embark-org-copy-exported-url link))) (when (not (string-match (regexp-quote "^https://web.archive.org") url)) (setq url (concat "https://web.archive.org/web/" (format-time-string "%Y%m%d%H%M%S/") url))) (when (called-interactively-p 'any) (kill-new url) (message "Copied %s" url)) url)) (defun my-embark-org-copy-exported-url (link &rest _) (interactive "MLink: \np") (let ((url (my-org-link-as-url link))) (when (and (derived-mode-p 'org-mode) (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK") (string-match "^/" url)) ;; local file links are copied to blog directories (setq url (concat "https://sachachua.com" (org-entry-get-with-inheritance "EXPORT_ELEVENTY_PERMALINK") (replace-regexp-in-string "[\\?&].*" "" (file-name-nondirectory link))))) (when (called-interactively-p 'any) (kill-new url) (message "Copied %s" url)) url)) (defun my-embark-replace-link-with-exported-url (link &rest _) (interactive (list (org-element-property :raw-link (org-element-context)))) (my-insert-or-replace-link (my-org-link-as-url link))) (with-eval-after-load 'embark-org (mapc (lambda (map) (keymap-set map "u" #'my-embark-org-copy-exported-url) (keymap-set map "U" #'my-embark-org-copy-exported-url-as-wayback) (keymap-set map "r" #'my-embark-replace-link-with-exported-url)) (list embark-url-map embark-org-link-map embark-org-link-copy-map)))
We'll see which one I end up using. I think both approaches might come in handy.
Quickly search my code
Since my-project-web-base-list
is a list of projects I often think
about or write about, I can also make something that searches through
them. That way, I don't have to care about where my code is.
(defun my-consult-ripgrep-code () (interactive) (consult-ripgrep (mapcar 'car my-project-web-base-list)))
I can add .rgignore
files in directories to tell ripgrep to ignore
things like node_modules
or *.json
.
I also want to search my Emacs configuration at the same time, although links to my config are handled by my dotemacs link type so I'll leave the URL as nil. This is also the way I can handle other unpublished directories.
(cl-pushnew (cons (expand-file-name "~/sync/emacs/Sacha.org") nil) my-project-web-base-list :test 'equal) (cl-pushnew (cons (expand-file-name "~/proj/static-blog/_includes") nil) my-project-web-base-list :test 'equal) (cl-pushnew (cons (expand-file-name "~/bin") nil) my-project-web-base-list :test 'equal)
Actually, let's throw my blog posts and Org files in there as well, since I often have code snippets. If it gets to be too much, I can always have different commands search different things.
(cl-pushnew (cons (expand-file-name "~/proj/static-blog/blog/") "https://sachachua.com/blog/") my-project-web-base-list :test 'equal) (cl-pushnew (cons (expand-file-name "~/sync/orgzly") nil) my-project-web-base-list :test 'equal)
I don't have anything bound to M-s c
(code) yet, so let's try that.
(keymap-global-set "M-s c" #'my-consult-ripgrep-code)
At some point, it might be fun to get Embark set up so that I can grab a link to something right from the consult-ripgrep interface. In the meantime, I can always jump to it and get the link.
- Tip from Omar: embark-around-action-hooks
consult-ripgrep
, sinceconsult-ripgrep
gives meconsult-grep
targets instead ofconsult-location
:(cl-defun embark-consult--at-location (&rest args &key target type run &allow-other-keys) "RUN action at the target location." (save-window-excursion (save-excursion (save-restriction (pcase type ('consult-location (consult--jump (consult--get-location target))) ('org-heading (org-goto-marker-or-bmk (get-text-property 0 'org-marker target))) ('consult-grep (consult--jump (consult--grep-position target))) ('file (find-file target))) (apply run args))))) (cl-pushnew #'embark-consult--at-location (alist-get 'org-store-link embark-around-action-hooks))
I think I can use it with
M-s c
to search for the code, thenC-. C-c l
on the matching line, whereC-c l
is my regular keybinding for storing links. Thanks, Omar!In general, I don't want to have to think about where something is on my laptop or where it's published on the Web, I just want to write about it. One step closer, yay Emacs!
Linking to headings that match a tag
(defun my-org-insert-matching-heading-links (match) (interactive "MMatch: ") (let ((org-tags-exclude-from-inheritance (list match))) (insert (string-join (org-map-entries (lambda () (concat "- " (org-link-make-string (car (org-link--file-link-to-here)) (org-entry-get (point) "ITEM")) (if (org-entry-get (point) "EXPORT_DATE") (format-time-string " (%Y)" (date-to-time (org-entry-get (point) "EXPORT_DATE"))) "") "\n")) match))) ""))
Links from org-protocol
So that I can easily add links at point. Formatted as an Org list for now.
(defun my-org-protocol-insert-link (info) "Store and insert the link at point based on INFO." (org-protocol-store-link info) (with-current-buffer (window-buffer (selected-window)) (insert "- ") (org-insert-last-stored-link 1) (insert "\n"))) (eval-after-load 'org-protocol '(add-to-list 'org-protocol-protocol-alist '("insert-link" :protocol "insert-link" :function my-org-protocol-insert-link))) ;; javascript:location.href = 'org-protocol://copy-thumbnail?thumbnail=' + encodeURIComponent(document.querySelector('meta[property=\"og:image\"]') ? document.querySelector('meta[property=\"og:image\"]').getAttribute('content') : '') + '&title=' + encodeURIComponent(document.title) + '&url=' + encodeURIComponent(location.href) + '&videoId=' + ((typeof(videoId) !== 'undefined' ? videoId : (document.querySelector('meta[itemprop=\"videoId\"]') ? document.querySelector('meta[itemprop=\"videoId\"]').getAttribute('content') : '')) || '') (defun my-get-youtube-info (url) (with-current-buffer (url-retrieve-synchronously url) (goto-char (point-min)) (prog1 (list :url url :title (when (re-search-forward "<title>\\(.*?\\)</title>" nil t) (match-string 1)) :duration (when (re-search-forward "approxDurationMs\":\"\\([0-9]+\\)\"" nil t) (format-seconds "%.2h:%.2m:%.2s%z" (/ (string-to-number (match-string 1)) 1000)))) (kill-buffer)))) (defun my-link-video (list) (when (stringp list) (setq list (list :url list))) (with-current-buffer (url-retrieve-synchronously (concat "https://video.link/bookmarklet?url=" (url-encode-url (plist-get list :url)))) (save-excursion (if (re-search-forward "<input type=\"text\" id=\"safeURL\" readonly=\"readonly\" value=\"\\(.*?\\)\"" nil t) (plist-put list :url (match-string-no-properties 1)) (plist-put list :url (replace-regexp-in-string "watch" "watch_popup" (plist-get list :url))))) (when (string= (or (plist-get list :thumbnail) "") "") (save-excursion (when (re-search-forward "<img id=\"videoThumb\" src=\"\\(.*?\\)\"" nil t) (plist-put list :thumbnail (match-string-no-properties 1))))) list)) (defun my-org-protocol-copy-thumbnail (info) "Store and insert the link at point based on INFO." (interactive "MURL: ") (when (stringp info) (setq info (list :url info))) (when (string-match "youtube\\.com" (plist-get info :url)) (setq info (my-link-video info))) (let ((date (format-time-string "%Y-%m-%d"))) (kill-new (if (string= (plist-get info :videoId) "") (format "{{<thumbnail image=\"%s\" title=\"%s\" link=\"%s\" date=\"%s\">}}\n" (plist-get info :thumbnail) (plist-get info :title) (plist-get info :url) date ) (format "{{<youtube id=\"%s\" title=\"%s\" link=\"%s\" date=\"%s\">}}\n" (plist-get info :videoId) (plist-get info :title) (plist-get info :url) date)))) nil) (eval-after-load 'org-protocol '(add-to-list 'org-protocol-protocol-alist '("copy-thumbnail" :protocol "copy-thumbnail" :function my-org-protocol-copy-thumbnail)))
Fix elisp links
(defun my-org-elisp-link-export (link description format &optional arg) (pcase format ('html (format "<span title=\"%s\">%s</span>" (replace-regexp-in-string "\"" """ link) description)) ((or 'icalendar 'ascii) description) )) (org-link-set-parameters "elisp" :export 'my-org-elisp-link-export)
IRC
(org-link-set-parameters "ircs" :export (lambda (link description format) "Export an ircs link. See `org-link-parameters' for details about LINK, DESCRIPTION and FORMAT." (let ((desc (or description link))) (pcase format (`html (format "<a href=\"ircs:%s\">%s</a>" link desc)) (`md (format "[%s](ircs:%s)" desc link)) (_ nil)))))
Dired
(setq dired-dwim-target t) (defun my-org-get-links-in-region (beg end) (save-excursion (let (results) (goto-char (min beg end)) (while (re-search-forward org-any-link-re (max beg end) t) (add-to-list 'results (org-element-context))) results))) (defun my-org-dired-file-links-in-region (beg end) "Display a Dired buffer for the file links in the selected region." (interactive "r") (let ((files (-map (lambda (x) (expand-file-name (org-link-unescape (plist-get (cadr x) :path)))) (-filter (lambda (x) (string= (plist-get (cadr x) :type) "file")) (my-org-get-links-in-region beg end))))) (with-current-buffer (get-buffer-create "*Files*") (let ((inhibit-read-only t)) (erase-buffer) (apply 'call-process "ls" nil t nil "-lR" files)) (dired-virtual "/") (switch-to-buffer (current-buffer)))))
Org protocol: following Org links from outside Emacs org emacs
_xor
had an interesting idea: can we use org-protocol
to link to
things inside Emacs, so that we can have a webpage with bookmarks into
our Org files? Here's a quick hack that reuses org-store-link
and
org-link-open
.
(defun org-protocol-open-link (info) "Process an org-protocol://open style url with INFO." (org-link-open (car (org-element-parse-secondary-string (plist-get info :link) '(link))))) (defun org-protocol-copy-open-link (arg) (interactive "P") (kill-new (concat "org-protocol://open?link=" (url-hexify-string (org-store-link arg))))) (with-eval-after-load 'org-protocol (add-to-list 'org-protocol-protocol-alist '("org-open" :protocol "open" :function org-protocol-open-link)))
To make exporting and following easier, we also need a little code to
handle org-protocol
links inside Org.
(defun org-protocol-follow (path &rest _) "Follow the org-protocol link for PATH." (org-protocol-check-filename-for-protocol (concat "org-protocol:" path) nil nil)) (defun org-protocol-export (path desc format info) "Export an org-protocol link." (setq path (concat "org-protocol:" path)) (setq desc (or desc path)) (pcase format (`html (format "<a href=\"%s\">%s</a>" path desc)) (`11ty (format "<a href=\"%s\">%s</a>" path desc)) (`latex (org-latex-link path desc info)) (`ascii (org-ascii-link path desc info)) (`md (org-md-link path desc info)) (_ path))) (with-eval-after-load 'org (org-link-set-parameters "org-protocol" :follow #'org-protocol-follow :export #'org-protocol-export))
Now I can use org-protocol-copy-open-link
to copy a link to the
current location, and I can put it into my Org files.
Example bare link to the Org manual, which will work only if you have
open
in the org-protocol-protocol-alist
:
org-protocol://open?link=%5B%5Binfo%3Aorg%23Protocols%5D%5Borg%23Protocols%5D%5D
With a description:
TODO Speed command for adding a custom ID to Org Mode posts
Nudged by Amit's post about adding custom IDs to Org headings, I decided to write a speed command to add a custom ID with a reasonable default, and to make it happen whenever I post something from my Emacs config (like this one). I'm running out of brainspace for speed commands, so I'm going to try sticking it into a hydra so that I can add future things to the hydra instead. I'll probably figure out some kind of cheat sheet thing for speed commands too.
(defun my-make-slug (s) (thread-last s (downcase) (replace-regexp-in-string "[^a-z0-9]+" "-") (replace-regexp-in-string "^-\\|-$" ""))) (defun my-org-set-custom-id (id) "Set the CUSTOM_ID property to ID at point." (interactive (list (let ((default-custom-id (my-make-slug (string-join (org-get-outline-path t) " ")))) (read-string (format "ID (%s): " default-custom-id) nil nil default-custom-id)))) (org-entry-put (point) "CUSTOM_ID" id)) (with-eval-after-load 'hydra (define-key hydra-base-map (kbd "<down>") 'my-hydra-pop) (define-key hydra-base-map (kbd "<up>") (lambda () (interactive) (my-hydra-go-and-push 'my-shortcuts/body))) (defhydra my-hydra/org-speed-commands () ("i" my-org-set-custom-id "CUSTOM_ID" :exit t) ("<up>" my-hydra/org-mode/body :exit t) ("u" (my-hydra-go-and-push 'my-hydra/org-mode/body) :exit t :hint nil)) (defhydra my-hydra/org-mode (:foreign-keys run) ("b" my-org-back-to-heading "Heading") ("n" org-forward-heading-same-level "Next") ("p" org-backward-heading-same-level "Previous") ("a" org-archive-subtree-default "Archive") ("j" my-org-mark-done-and-add-to-journal "Journal" :exit t) ("k" org-cut-subtree "Kill") ("<up>" (my-hydra-go-and-push 'my-shortcuts/body) :exit t hint nil) ("u" (my-hydra-go-and-push 'my-shortcuts/body) :exit t :hint nil) ("<f14>" nil "Exit" :exit t)) (defhydra my-hydra/org-link () ("RET" org-open-at-point "Open") ("e" org-insert-link "Edit") ("c" my-caption-show "Captions") ("w" my-org-link-element-copy-link "Copy link") ("u" (my-hydra-go-and-push 'my-hydra/org-mode/body) :exit t :hint nil) ("<up>" (my-hydra-go-and-push 'my-hydra/org-mode/body) :exit t :hint nil)) (defhydra my-hydra/org-src () ("e" org-babel-execute-src-block "Exec") ("E" my-org-execute-src-block-by-name "Exec by name") ("i" org-edit-special "Edit") ("d" org-babel-demarcate-block "Demarcate") ("g" org-babel-goto-named-src-block "Goto") ("r" org-babel-open-src-block-result "Result") ("x" org-babel-expand-src-block "Expand") ("t" (org-babel-tangle '(4)) "Tangle at point") ("T" (org-babel-tangle '(16)) "Tangle target file") ("u" (my-hydra-go-and-push 'my-hydra/org-mode/body) :exit t :hint nil) ("<up>" (my-hydra-go-and-push 'my-hydra/org-mode/body) :exit t :hint nil) ) (defun my-hydra/dwim () (interactive) (if (derived-mode-p 'org-mode) (let ((context (org-element-context))) (cond ((and (bolp) (looking-at org-outline-regexp)) (my-hydra/org-speed-commands/body)) ((org-in-src-block-p) (my-hydra/org-src/body)) ((eq (org-element-type context) 'link) (my-hydra/org-link/body)) (t (my-hydra/org-mode/body)))) (my-shortcuts/body))) (define-key org-mode-map (kbd "<f14>") 'my-hydra/dwim) (keymap-global-set "<f14>" 'my-hydra/dwim))
Journal
(defvar my-journal-category-map '(("Gross" . "Gross motor") ("Fine" . "Fine motor") ("8 - Kaizen" . "Kaizen") ("9 - Us" . "Us") ("Self-care" . "Self-care and independence")) "Alist of string replacements for journal categories.") (defvar my-journal-categories '("Kaizen" "Us" "Field trip" "Gross motor" "Fine motor" "Sensory" "Language" "Music" "Art" "Self-care and independence" "Eating" "Sleep" "Emotion" "Household" "Social" "Pretend" "Cognition" "World" "Other" "Oops" "Thoughts" "Consulting" "Track" "Uncategorized") "List of categories to display. Unknown categories will be added to the end.") (defun my-journal-date (o) (elt o 3)) (defun my-journal-note (o) (car o)) (defun my-journal-week-highlight (o) (elt o 4)) (defun my-journal-category (o) (elt o 1)) (defun my-journal-pictures (o) (when (string> (elt o 2) "") (split-string (elt o 2) ","))) (defun my-journal-id (o) (elt o 7)) (defun my-journal-status (o) (elt o 8)) (defun my-journal-other (o) (elt o 9)) (defun my-journal-zidstring (o) (elt o 11)) (defun my-org-group-journal-entries (filtered &optional category-map categories) (setq category-map (or category-map (my-journal-category-map))) (setq categories (or categories (my-journal-categories))) (let* ((grouped (-group-by 'my-journal-category filtered)) (mapped-list (mapcar (lambda (o) (cons (or (assoc-default (car o) category-map) (car o)) (cdr o))) grouped)) (sorted-list (delq nil (append (mapcar (lambda (cat) (when (assoc-default cat mapped-list) (cons cat (assoc-default cat mapped-list)))) categories) (-remove (lambda (o) (member (car o) categories)) mapped-list))))) sorted-list)) (defun my-org-date-to-string (date &optional base-date) "Return the Org date specified by DATE. This is relative to BASE-DATE if specified." (org-read-date nil nil date nil (when base-date (org-read-date nil t base-date)))) (ert-deftest my-org-date-to-string () (should (string= (my-org-date-to-string "++1" "2018-08-01") "2018-08-02"))) (defun my-org-filter-journal-csv (filename &optional from to highlight base-date) "Return a list of matching entries." (setq from (and from (substring (my-org-date-to-string from base-date) 0 10)) to (and to (substring (my-org-date-to-string to base-date) 0 10))) (let* ((data (pcsv-parse-file filename)) (filtered (-filter (lambda (o) (let ((date (my-journal-date o))) (and (or (null from) (not (string< date from))) (or (null to) (string< date to)) (and (not (string= (my-journal-status o) "Deleted"))) (not (string-match "^!" (my-journal-note o))) (string-equal "true" (cond ((null highlight) "true") ((string-equal highlight "week") (my-journal-week-highlight o)) (t "true")))))) data))) filtered)) (defun my-journal-read-category (&optional initial) (consult--read my-journal-categories :sort nil :prompt "Category: " :initial initial)) (defun my-journal-guess-category () (save-excursion (org-back-to-heading) (org-end-of-meta-data) (let ((text (buffer-substring-no-properties (point) (org-end-of-subtree)))) (if (string-match "#gardening" text) "Household")))) (defun my-journal-post (note &rest plist) (interactive (list (read-string "Note: ") :Date (concat (org-read-date "Date: ") " 23:00") :Category (my-journal-read-category (condition-case nil (my-journal-guess-category) (error nil))) :Other (read-string "Other: "))) (setq plist (append `(:Note ,note) plist)) (let ((url-request-method "POST") (url-request-extra-headers `(("Content-Type" . "application/json") ("Authorization" . ,(concat "Basic " (base64-encode-string (concat my-journal-user ":" my-journal-password)))))) (json-object-type 'plist) (url-request-data (encode-coding-string (json-encode-plist plist) 'utf-8)) data) (with-current-buffer (url-retrieve-synchronously (concat my-journal-url "/api/entries")) (goto-char (point-min)) (re-search-forward "^$") (setq data (json-read)) (message "%s" (plist-get data :ZIDString)) data))) (defun my-journal-get-by-zidstring (zidstring) (my-journal-get (concat "api/entries/" zidstring))) (defun my-journal-insert-ref (zidstring) (interactive (list (my-journal-completing-read))) (insert (org-link-make-string (concat "ref:" (my-journal-id-from-string zidstring))))) (defun my-journal-edit (zidstring) (interactive (list (my-journal-completing-read))) (let* ((id (my-journal-id-from-string zidstring)) (entry (and id (my-journal-get-by-zidstring id)))) (if (null id) (my-journal-post zidstring :Category (my-journal-read-category (plist-get entry :Category)) :Other (read-string "Other: " (plist-get entry :Other))) (plist-put entry :Note (read-string (format "Note (%s): " (plist-get entry :Note)))) (plist-put entry :Category (my-journal-read-category (plist-get entry :Category))) (plist-put entry :Other (read-string "Other: " (plist-get entry :Other))) (my-journal-update entry)))) (defun my-journal-update (plist) "Update journal entry using PLIST." (let ((url-request-method "PUT") (url-request-data (json-encode-plist plist))) (my-json-request (concat my-journal-url "/api/entries/" (plist-get plist :ZIDString))))) ;; (my-journal-post "Hello, world") (defun my-journal-get-entries (&optional from to search) "Return parsed CSV of entries limited by FROM, TO, and SEARCH." (with-current-buffer (url-retrieve-synchronously (format "%s/api/entries.csv?from=%s&to=%s®ex=1&q=%s" my-journal-url (or from "") (or to "") (or search ""))) (goto-char (point-min)) (delete-region (point-min) (search-forward "\n\n")) (cdr (pcsv-parse-buffer)))) (defun my-journal-get (url) (let ((url-request-extra-headers `(("Authorization" . ,(concat "Basic " (base64-encode-string (concat my-journal-user ":" my-journal-password))))))) (my-json-request (concat my-journal-url "/" url)))) (defun my-journal-get-entry (zid) (my-journal-get (format "api/entries/zid/%s" zid)))
The following code lets me complete journal entries and get their ZIDs.
(defun my-json-request (url) (let ((json-object-type 'plist) (url-request-extra-headers (cons '("Content-Type" . "application/json") url-request-extra-headers))) (with-current-buffer (url-retrieve-synchronously url) (goto-char (point-min)) (re-search-forward "^$" nil t) (json-read)))) (defvar my-journal-search-cache nil "List of search results.") (defun my-journal-search-query (query-str) (let* ((url-request-method "GET") (json-response (my-journal-get (format "api/entries?q=%s&limit=50&sort=date®ex=1" query-str)))) (setq my-journal-search-cache (mapcar (lambda (o) (cons (format "%s %s" (plist-get o :ZIDString) (plist-get o :Note)) o)) json-response)))) (defun my-journal-search-query-async (query-str next) (let* ((url-request-method "GET") (url-request-extra-headers (cons '("Content-Type" . "application/json") url-request-extra-headers))) (url-retrieve (format "%s/api/entries?q=%s&limit=50&sort=date®ex=1" my-journal-url query-str) (lambda (status) (goto-char (point-min)) (re-search-forward "^$" nil t) (setq my-journal-search-cache (mapcar (lambda (o) (cons (format "%s %s" (plist-get o :ZIDString) (plist-get o :Note)) o)) (let ((json-object-type 'plist)) (json-read)))) (funcall next 'flush) (if my-journal-search-cache (funcall next my-journal-search-cache)))))) (defun my-journal--async-search (next) (lambda (action) (cond ((eq action 'setup) ;; Should figure out how to start (my-journal-search-query-async "" next)) ((and (stringp action) (not (string= action ""))) (my-journal-search-query-async action next)) (t (funcall next action))))) (defun my-journal-completing-read () (interactive) (consult--read (thread-first (consult--async-sink) (consult--async-refresh-immediate) (my-journal--async-search) (consult--async-throttle) (consult--async-split)) :sort nil :prompt "Entry: " :category 'journal)) (defun my-journal-id-from-string (s) (when (string-match "^[-0-9]+" s) (match-string 0 s))) (defun my-journal-view (s) (interactive (list (my-journal-completing-read))) (my-org-journal-open (my-journal-id-from-string s))) (defun my-journal-sketch-large (zid) "Create a large sketch based on ZID." (interactive (list (my-journal-completing-read))) (let ((filename (expand-file-name (format "%s.psd" (my-journal-id-from-string zid)) my-sketch-inbox-directory))) (unless (file-exists-p filename) (copy-file my-sketch-large-template-file filename)) (my-org-sketch-open filename)))
I should probably figure out how to switch this over to my Consult-based workflow:
(defun my-journal-format-entry (type o) (cond ((eq type 'org-link-zid-only) (org-link-make-string (format "journal:%s" (cdr (assoc 'ZIDString o))))) ((eq type 'list-item-with-zid) (format "- %s (%s)\n" (assoc-default 'Note o) (org-link-make-string (format "journal:%s" (assoc-default 'ZIDString o))))) ((eq type 'list-item) (format "- %s\n" (assoc-default 'Note o))) ((eq type 'text) (assoc-default 'Note o)))) (defun my-journal-format-entries (type list) (mapconcat (lambda (o) (my-journal-format-entry type o)) (reverse list) (cond ((eq type 'org-link-zid-only) ", ") ((eq type 'list-item-with-zid) "") ((eq type 'list-item) "") ((eq type 'text) " "))))
This lets me define a custom link type.
(defun my-org-journal-open (id