This commit is contained in:
bth 2024-01-13 11:57:23 -08:00
commit 5af6be552f

View file

@ -1,19 +1,25 @@
;;; uldb.el --- An ultralight database for composition. -*- lexical-binding: t -*- ;;; um.el --- An Ultralight database for Markdown composition. -*- lexical-binding: t -*-
;; by bth ;; by bth
;; An ultralight database for writing and project composition, using only unique ;; Um is an ultralight database design and emacs toolkit for organizing writing
;; filenames, POSIX filesystem conventions, and the builtin `project' package. ;; into larger compositions. It uses only unique filenames, POSIX filesystem
;; conventions, the builtin `project' package, and standard POSIX commandline
;; tools to build out the CLI.
;; It consists of two parts:
;; 1. The elisp for functionality within emacs.
;; 2. Bash scripts for the commandline interface.
;; This is somewhat like org-roam, except without any database dependency. (And ;; This is somewhat like org-roam, except without any database dependency. (And
;; it uses Markdown rather than org, which I don't care for.) ;; it assumes Markdown rather than org, which I don't care for.)
;; This depends on a few simple ideas: ;; This depends on a few simple ideas:
;; 1. A numbered filename specification which serves as unique id. ;; 1. A numbered filename specification which serves as unique id.
;; 2. Placing that same id into the file header, so that concatenated files ;; 2. Placing that same id into the file header, so that concatenated files
;; have reference back to their source. See the `mdcat' utility. ;; have reference back to their source. See the `um cat` command.
;; 3. Using a source "journal/" directory, where source files should first be ;; 3. Using a source "journal/" directory, where source files should first be
;; composed and where we can assume a file exists if not elsewhere. ;; composed and where we can assume a file exists if not elsewhere.
@ -24,38 +30,38 @@
;; 5. (Optional) Use `embark' to visit files with a single keystroke. ;; 5. (Optional) Use `embark' to visit files with a single keystroke.
;; features provided: ;; features provided:
;; `uldb-journal-header' defines the standard header ;; `um-journal-header' defines the standard header
;; `uldb-project-find-meta' via `project-switch-project': open a file like ;; `um-project-find-meta' via `project-switch-project': open a file like
;; *meta.md in a given project. ;; *meta.md in a given project.
;; `uldb-file-at-point-advice' via `embark-dwim': open file in known projects ;; `um-file-at-point-advice' via `embark-dwim': open file in known projects
;; with fallback to journal/ ;; with fallback to journal/
;; `uldb-grep-tag': search files with same tag ;; `um-grep-tag': search files with same tag
(require 'package) (require 'package)
;; Primary path glob for the journal. This allows various mountpoints. ;; Primary path glob for the journal. This allows various mountpoints.
(setq uldb-journal-path-glob ".*/writing/journal") (setq um-journal-path-glob ".*/writing/journal")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; journal header ;; journal header
(defun uldb-iso-8601 () (defun um-iso-8601 ()
"Insert a date stamp in ISO 8601 order, but with periods in place of dashes." "Insert a date stamp in ISO 8601 order, but with periods in place of dashes."
(format-time-string "%Y.%m.%d") (format-time-string "%Y.%m.%d")
) )
(defun uldb-journal-header () (defun um-journal-header ()
"Create a uldb-journal-header composed of: "Create a um-journal-header composed of:
# buffer-name minus the .md file type # buffer-name minus the .md file type
: date : date
" "
(interactive) (interactive)
(insert (insert
(format "# %s\n: %s\n\n" (substring (buffer-name) 0 -3) (uldb-iso-8601)) (format "# %s\n: %s\n\n" (substring (buffer-name) 0 -3) (um-iso-8601))
) )
) )
@ -64,7 +70,7 @@
;; normally .git detection works fine. But for my journal/ I don't git. ;; normally .git detection works fine. But for my journal/ I don't git.
;; https://michael.stapelberg.ch/posts/2021-04-02-emacs-project-override/ ;; https://michael.stapelberg.ch/posts/2021-04-02-emacs-project-override/
(defun uldb-project-override (dir) (defun um-project-override (dir)
"Returns the parent directory containing a .project.el file, "Returns the parent directory containing a .project.el file,
if any, to override the standard project.el detection logic when if any, to override the standard project.el detection logic when
needed. needed.
@ -74,16 +80,16 @@
(list 'vc nil override) (list 'vc nil override)
nil))) nil)))
;; Cannot use :hook because 'project-find-functions does not end in -hook ;; Cannot use :hook because 'project-find-functions does not end in -hook
(add-hook 'project-find-functions #'uldb-project-override) (add-hook 'project-find-functions #'um-project-override)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; find-file-at-point ;; find-file-at-point
;; the journal/ serves as content origin, so it must be treated specially. ;; the journal/ serves as content origin, so it must be treated specially.
(setq uldb-journal-path (car (seq-filter (setq um-journal-path (car (seq-filter
(lambda (path) (lambda (path)
;; this way I don't have to hardcode the full path: ;; this way I don't have to hardcode the full path:
(string-match uldb-journal-path-glob path)) (string-match um-journal-path-glob path))
;; stores all project roots in a list of strings: ;; stores all project roots in a list of strings:
(project-known-project-roots)))) (project-known-project-roots))))
@ -93,19 +99,19 @@
;; run find-file at point, followed by M-n : ;; run find-file at point, followed by M-n :
;; TODO: reuse same fallback logic as the embark advice if I keep this. ;; TODO: reuse same fallback logic as the embark advice if I keep this.
(defun uldb-journal-find-file () (defun um-journal-find-file ()
(let ((default-directory uldb-journal-path) (let ((default-directory um-journal-path)
(thing (thing-at-point 'filename)) (thing (thing-at-point 'filename))
) )
(expand-file-name thing)) (expand-file-name thing))
) )
(add-hook 'file-name-at-point-functions 'uldb-journal-find-file nil t) (add-hook 'file-name-at-point-functions 'um-journal-find-file nil t)
;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;
;; Embark solution (optional) ;; Embark solution (optional)
;; Load this with an advice: ;; Load this with an advice:
;; (advice-add 'embark-target-file-at-point :around 'uldb-file-at-point-advice) ;; (advice-add 'embark-target-file-at-point :around 'um-file-at-point-advice)
;; `embark-target-file-at-point' uses `ffap-file-at-point', which uses ;; `embark-target-file-at-point' uses `ffap-file-at-point', which uses
;; `default-directory' to expand the filename. ;; `default-directory' to expand the filename.
@ -114,7 +120,7 @@
;; `embark-target-finders', since I'd have to remove the file finder and put my ;; `embark-target-finders', since I'd have to remove the file finder and put my
;; function in the same place in the list anyway. ;; function in the same place in the list anyway.
(defun uldb-file-at-point-advice (origfunc) (defun um-file-at-point-advice (origfunc)
"Like find-file-at-point, but checks all known project paths. "Like find-file-at-point, but checks all known project paths.
In this order: In this order:
@ -136,7 +142,7 @@ in the root dir.
(cl-loop for project-path in (cl-loop for project-path in
(seq-remove (seq-remove
(lambda (path) (lambda (path)
(or (string-match uldb-journal-path path) (or (string-match um-journal-path path)
(when (project-current) (when (project-current)
(string-match (caddr (project-current)) path)) (string-match (caddr (project-current)) path))
)) ))
@ -148,14 +154,14 @@ in the root dir.
)) ))
;; journal path ;; journal path
(let ((default-directory uldb-journal-path)) (let ((default-directory um-journal-path))
(funcall origfunc)) (funcall origfunc))
)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; C-x p p ;; C-x p p
(defun uldb-project-find-meta () (defun um-project-find-meta ()
(interactive) (interactive)
;; this works because `project-switch-project' overrides the dir: ;; this works because `project-switch-project' overrides the dir:
(find-file (expand-file-name "*meta.md" (caddr (project-current))) t) (find-file (expand-file-name "*meta.md" (caddr (project-current))) t)
@ -164,7 +170,7 @@ in the root dir.
;; overwrite ;; overwrite
(setq project-switch-commands (setq project-switch-commands
'( '(
(uldb-project-find-meta "open meta" "m") (um-project-find-meta "open meta" "m")
(project-dired "dired") (project-dired "dired")
(project-find-file "find file") (project-find-file "find file")
(project-find-regexp "find regexp") (project-find-regexp "find regexp")
@ -174,7 +180,7 @@ in the root dir.
;; tags ;; tags
;; TODO: do I want to search all projects? ;; TODO: do I want to search all projects?
(defun uldb-grep-tag () (defun um-grep-tag ()
"Run project-find-regexp on the current identifer as a journal frontmatter tag. "Run project-find-regexp on the current identifer as a journal frontmatter tag.
NOTE: this searches in the current project root only. NOTE: this searches in the current project root only.
@ -190,4 +196,4 @@ NOTE: this searches in the current project root only.
;; Or, in dired, run `find-grep-dired'. ;; Or, in dired, run `find-grep-dired'.
(provide 'uldb) (provide 'um)