Add org-roam-slipbox

Readme.org

@@ -47,6 +47,10 @@ UI. Contrasts with the normal org-roam buffer, which only shows backlinks.
 A version of =consult-ripgrep= that shows node titles instead of filenames so you
 don't have to guess anymore.
 
+** INCUBATING [[file:lisp/org-roam-slipbox.el][org-roam-slipbox]] (/incubating/)
+Automatically tag nodes according to the name of the directory they're in, and
+easily refile between these directories.
+
 ** SPIKE [[file:lisp/org-roam-gc.el][org-roam-gc]] /(spike)/
 Automatically delete empty dailies files so they don't build up forever.
 

lisp/org-roam-slipbox.el

@@ -0,0 +1,173 @@
+;;; org-roam-slipbox.el --- Teach org-roam how to handle multiple slipboxes  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Chris Barrett
+
+;; Author: Chris Barrett <chris@walrus.cool>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A 'slipbox' is a distinct folder of notes related to a specific topic or
+;; context that should be differentiated from other notes in your Zettelkasten.
+;; Broadly speaking, they represent mutually exclusive categories of notes.
+;;
+;; For example, you might maintain separate slipboxes for Evergreen Notes, notes
+;; to do with your job or specific clients, and your dailies.
+
+;; When searching notes, or using dynamic blocks to build lists of notes[1],
+;; it's useful to have a tag corresponding to the slipbox to enable filtering.
+;; This package hooks into org-roam's indexing so that a slipbox tag is
+;; automatically applied when the note is indexed, saving you from having to add
+;; the tag yourself. It also provides a function to 'refile' from one slipbox to
+;; another[2] in a structured way.
+;;
+;; The slipbox tag is computed based on the name of the folder:
+;;
+;;   `org-roam-directory' -> tagged with `org-roam-slipbox-default'
+;;      |
+;;      |--- dailies  -> tagged with :dailies:
+;;      |--- outlines -> tagged with :outlines:
+;;      \--- work     -> tagged with :work:
+;;
+;; [1]: see `org-roam-dblocks'
+;;
+;; [2]: see `org-roam-slipbox-refile'.
+;;
+
+;;; Installation:
+
+;;    (use-package org-roam-slipbox
+;;      :after org-roam
+;;      :demand t
+;;      :config
+;;      (org-roam-slipbox-tag-mode +1))
+;;
+;; After enabling the mode, run `C-u M-x org-roam-db-sync' to rebuild your notes
+;; index. Thereafter, the slipbox tag will automatically be applied at
+;; indexing-time.
+
+;;; Code:
+
+(require 'f)
+(require 'magit)
+(require 'org-roam)
+(require 'org-roam-rewrite)
+
+(defgroup org-roam-slipbox nil
+  "Teach org-roam how to interpret multiple slipboxes."
+  :group 'productivity
+  :prefix "org-roam-slipbox-")
+
+(defcustom org-roam-slipbox-default "notes"
+  "A 'default' slipbox tag to apply for nodes not in a slipbox.
+
+Nodes at the top-level of the org-roam directory will have this
+tag applied."
+  :group 'org-roam-slipbox
+  :type '(choice (string :tag "Tag")
+                 (const :tag "None" nil)))
+
+(defcustom org-roam-slipbox-after-refile-hook nil
+  "Hook run after a node is refiled via `org-roam-slipbox-refile'."
+  :group 'org-roam-slipbox
+  :type 'hook)
+
+(defface org-roam-slipbox-name
+  '((t
+     (:inherit font-lock-string-face)))
+  "Face for references to slipboxes."
+  :group 'org-roam-slipbox)
+
+(defcustom org-roam-slipbox-use-git-p t
+  "Whether to update git when modifying nodes in slipboxes."
+  :group 'org-roam-slipbox
+  :type 'boolean)
+
+
+
+(defun org-roam-slipbox-from-file (file)
+  (condition-case nil
+      (let* ((dir (f-dirname file))
+             (name  (s-replace " " "_" (file-name-nondirectory dir))))
+        (cond ((f-same-p dir org-roam-directory)
+               org-roam-slipbox-default)
+              ((string-match-p org-tag-re name)
+               name)
+              ;; NB. If `name' isn't a legal tag, apply the default.
+              (t
+               org-roam-slipbox-default)))
+    (error org-roam-slipbox-default)))
+
+;;;###autoload
+(cl-defmethod org-roam-node-slipbox ((node org-roam-node))
+  "Return the slipbox a NODE belongs to.
+
+See also: `org-roam-slipbox-default'."
+  (org-roam-slipbox-from-file (org-roam-node-file node)))
+
+(defun org-roam-slipbox--rename-with-magit (from to)
+  ;; Ensure the file is tracked by git.
+  (magit-call-git "add" (magit-convert-filename-for-git from))
+  (magit-file-rename from to))
+
+;;;###autoload
+(defun org-roam-slipbox-refile (node slipbox)
+  "Move NODE into SLIPBOX."
+  (interactive (let* ((node (org-roam-node-at-point t))
+                      (current-slipbox (org-roam-node-slipbox node))
+                      (slipboxes (seq-difference (seq-map #'f-base (f-directories org-roam-directory))
+                                                 (list current-slipbox))))
+                 (list node
+                       (completing-read "Slipbox: " slipboxes nil t))))
+
+  (let ((current-slipbox (org-roam-node-slipbox node))
+        dest)
+    (cond
+     ((zerop (org-roam-node-level node))
+      (let ((file (org-roam-node-file node)))
+        (setq dest (f-join org-roam-directory slipbox (f-filename file)))
+        (if org-roam-slipbox-use-git-p
+            (org-roam-slipbox--rename-with-magit file dest)
+          (rename-file file dest))
+        (org-roam-db-sync)))
+     (t
+      (let ((new-file (f-filename (org-roam-rewrite--new-filename-from-capture-template node))))
+        (setq dest (f-join org-roam-directory slipbox new-file))
+        (org-roam-rewrite-extract node dest))))
+
+    (run-hooks 'org-roam-slipbox-after-refile-hook)
+
+    (message (concat "Refiled from "
+                     (propertize current-slipbox 'face 'org-roam-slipbox-name)
+                     " to "
+                     (propertize slipbox 'face 'org-roam-slipbox-name)))))
+
+(defun org-roam-slipbox--ad-append-slipbox-tag (&optional _tags-only)
+  (when-let* ((slipbox (ignore-errors (org-roam-slipbox-from-file (buffer-file-name)))))
+    (add-to-list 'org-file-tags slipbox)))
+
+;;;###autoload
+(define-minor-mode org-roam-slipbox-tag-mode
+  "Automatically add a node's slipbox as a tag."
+  :global t
+  (cond
+   (org-roam-slipbox-tag-mode
+    (advice-add 'org-set-regexps-and-options :after #'org-roam-slipbox--ad-append-slipbox-tag))
+   (t
+    (advice-remove 'org-set-regexps-and-options #'org-roam-slipbox--ad-append-slipbox-tag))))
+
+(provide 'org-roam-slipbox)
+
+;;; org-roam-slipbox.el ends here