fixing the site

This commit is contained in:
2025-12-28 20:41:18 +00:00
parent 5db24213bd
commit bb6b6c5768
487 changed files with 94631 additions and 8059 deletions

View File

@@ -1,166 +0,0 @@
:PROPERTIES:
:ID: 0217f537-442a-4593-8c69-d481f0d1f2a8
:END:
#+title: keyboard
#+filetags: :hardware:linux:
This all comes from the fact that a “key press” isnt one thing — its a stack of specs and translations from **keyboard hardware → USB/HID → Linux kernel → userspace (XKB/Wayland) → Hyprland binds**.
Here are some structured notes you can keep / refer back to 👇
---
## 1. Big picture: what happens when you press a key?
When you hit a key (like your “lock” key), roughly this happens:
```text
Physical switch on keyboard
Keyboard firmware → USB HID "usage" (e.g. 0x07:0xE3 = Left GUI)
Linux kernel input subsystem (evdev) → KEY_LEFTMETA (code 125)
libinput / xkbcommon → keysyms (like Super_L, L, etc.)
Hyprland → your `bind = SUPER, L, exec, ...`
```
The “topic” weve been poking at is basically **understanding each layer in that stack**.
---
## 2. USB HID: where `700e3` comes from
Modern USB keyboards follow the **USB HID (Human Interface Device) specification**.
This spec defines **Usage Tables**: numerical codes for things like keys, buttons, axes, etc.
* The keyboard page is **Usage Page 0x07 (Keyboard/Keypad)**.
* In your `evtest` output, `MSC_SCAN value 700e3` means:
* `0x07` (Keyboard page)
* `0xE3` (Left GUI / “Windows/Super” key)
You can see the official tables here (PDF):
* **HID Usage Tables (includes Keyboard/Keypad page 0x07)**
[https://usb.org/sites/default/files/hut1_21.pdf](https://usb.org/sites/default/files/hut1_21.pdf) ([USB Implementers Forum][1])
If you scroll to the **Keyboard/Keypad Page (0x07)** section, it lists all the key usages: A, B, C, modifiers, function keys, etc. Theres also a standalone Keyboard/Keypad-page extract people mirror, like this PDF snippet: ([d1.amobbs.com][2])
So:
* `700e3` = Page `0x07`, Usage `0xE3` → *Keyboard Left GUI*
* `7000f` = Page `0x07`, Usage `0x0F` → *Keyboard L* key
Thats how we knew your lock key was sending **Super + L**.
---
## 3. Linux input subsystem: `EV_MSC`, `EV_KEY`, `KEY_LEFTMETA`
Linux has a dedicated **input subsystem** in the kernel (`drivers/input`, `drivers/hid` etc.) that takes those HID usages and turns them into a unified stream of **input events**. ([Linux Kernel Documentation][3])
Key ideas:
* Devices expose `/dev/input/eventX` nodes.
* Each event is a struct with:
* `type` (e.g. `EV_KEY`, `EV_MSC`, `EV_REL`, `EV_SYN`)
* `code` (e.g. `KEY_L`, `KEY_LEFTMETA`)
* `value` (pressed = 1, released = 0, repeat = 2)
Docs worth bookmarking:
* **Linux input subsystem overview**
[https://docs.kernel.org/input/input.html](https://docs.kernel.org/input/input.html) ([Linux Kernel Documentation][3])
* **Input event types and codes (`event-codes.txt`)**
[https://www.kernel.org/doc/Documentation/input/event-codes.txt](https://www.kernel.org/doc/Documentation/input/event-codes.txt) ([Kernel.org][4])
The **keycode definitions** (`KEY_L`, `KEY_LEFTMETA`, etc.) live in:
* `include/uapi/linux/input-event-codes.h` in the kernel source
Example mirror:
[https://raw.githubusercontent.com/torvalds/linux/master/include/uapi/linux/input-event-codes.h](https://raw.githubusercontent.com/torvalds/linux/master/include/uapi/linux/input-event-codes.h) ([GitHub][5])
When `evtest` prints:
```text
type 4 (EV_MSC), code 4 (MSC_SCAN), value 700e3
type 1 (EV_KEY), code 125 (KEY_LEFTMETA), value 0
```
that means:
* `EV_MSC / MSC_SCAN` → “Here is the raw hardware scancode” (from USB HID).
* `EV_KEY / KEY_LEFTMETA` → “Linux mapped that scancode to logical key LEFTMETA”.
## 4. XKB / xkbcommon: mapping to actual characters & modifiers
Above the kernel, youve got an extra mapping layer that says:
> For keycode N, with this layout, when Shift is held, produce this character/symbol.
On X11 this is handled by **XKB (X Keyboard Extension)**; on Wayland compositors (including Hyprland) the same ideas are implemented via **xkbcommon**.
Docs:
* **X Keyboard Extension (XKB) protocol spec**
[https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html](https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html) ([X.Org][6])
* **Arch Wiki: X keyboard extension** (good high-level intro)
[https://wiki.archlinux.org/title/X_keyboard_extension](https://wiki.archlinux.org/title/X_keyboard_extension) ([ArchWiki][7])
* A nice “practical” walkthrough of XKB concepts:
[https://medium.com/@damko/a-simple-humble-but-comprehensive-guide-to-xkb-for-linux-6f1ad5e13450](https://medium.com/@damko/a-simple-humble-but-comprehensive-guide-to-xkb-for-linux-6f1ad5e13450) ([Medium][8])
Hyprland, Sway, etc. all use libinput + xkbcommon under the hood to interpret those keycodes and translate them into keysyms and modifiers.
---
## 5. Hyprland / your config: where the bindings fit in
Hyprland sits at the top of this stack:
* It listens to the input events (via libinput).
* It sees keysyms/modifiers (e.g. `Super`, `L`).
* It matches them against your config:
```ini
bind = SUPER, L, exec, hyprlock
```
So your keyboards “lock” key:
1. Firmware sends HID usages `0xE3` (Left GUI) and `0x0F` (L).
2. Linux maps them to `KEY_LEFTMETA` (125) and `KEY_L` (38).
3. xkbcommon maps that to `Super` + `L`.
4. Hyprland says: “Ah, SUPER+L → run `hyprlock`”.
The “topic” you stumbled into is just **peeling back each abstraction layer**.
## 6. Handy tools & libraries if you want to go deeper
* `evtest`, `libinput debug-events`, `showkey`
→ To watch what your keyboard is actually sending.
* **Python-evdev** Python bindings to read `/dev/input/event*` yourself:
[https://python-evdev.readthedocs.io/](https://python-evdev.readthedocs.io/) ([python-evdev.readthedocs.io][9])
* Linux input subsystem docs again:
[https://docs.kernel.org/driver-api/input.html](https://docs.kernel.org/driver-api/input.html) ([Linux Kernel Documentation][10])
---
[1]: https://usb.org/sites/default/files/hut1_21.pdf?utm_source=chatgpt.com "HID Usage Tables"
[2]: https://d1.amobbs.com/bbs_upload782111/files_47/ourdev_692986N5FAHU.pdf?utm_source=chatgpt.com "10 Keyboard/Keypad Page (0x07)"
[3]: https://docs.kernel.org/input/input.html?utm_source=chatgpt.com "1. Introduction — The Linux Kernel documentation"
[4]: https://www.kernel.org/doc/Documentation/input/event-codes.txt?utm_source=chatgpt.com "event-codes.txt"
[5]: https://raw.githubusercontent.com/torvalds/linux/master/include/uapi/linux/input-event-codes.h?utm_source=chatgpt.com "Input event codes - GitHub"
[6]: https://www.x.org/releases/X11R7.7/doc/kbproto/xkbproto.html?utm_source=chatgpt.com "The X Keyboard Extension: Protocol Specification"
[7]: https://wiki.archlinux.org/title/X_keyboard_extension?utm_source=chatgpt.com "X keyboard extension"
[8]: https://medium.com/%40damko/a-simple-humble-but-comprehensive-guide-to-xkb-for-linux-6f1ad5e13450?utm_source=chatgpt.com "A simple, humble but comprehensive guide to XKB for linux"
[9]: https://python-evdev.readthedocs.io/?utm_source=chatgpt.com "Introduction — Python-evdev - Read the Docs"
[10]: https://docs.kernel.org/driver-api/input.html?utm_source=chatgpt.com "Input Subsystem"

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1 @@
Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2025-12-26T10:05:02+0000 using EDDSA

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,28 @@
;;; cond-let-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from cond-let.el
(register-definition-prefixes "cond-let" '("cond-let"))
;;; End of scraped data
(provide 'cond-let-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; cond-let-autoloads.el ends here

View File

@@ -0,0 +1,8 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "cond-let" "20251101.1942"
"Additional and improved binding conditionals."
'((emacs "28.1"))
:url "https://github.com/tarsius/cond-let"
:commit "288b7d36563223ebaf64cb220a3b270bdffb63f1"
:revdesc "288b7d365632"
:keywords '("extensions"))

View File

@@ -0,0 +1,534 @@
;;; cond-let.el --- Additional and improved binding conditionals -*- lexical-binding:t -*-
;; Copyright (C) 2025 Jonas Bernoulli
;; May contain traces of Emacs, which is
;; Copyright (C) 1985-2025 Free Software Foundation, Inc.
;; Authors: Jonas Bernoulli <emacs.cond-let@jonas.bernoulli.dev>
;; Homepage: https://github.com/tarsius/cond-let
;; Keywords: extensions
;; Package-Version: 20251101.1942
;; Package-Revision: 288b7d365632
;; Package-Requires: ((emacs "28.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This is an ALPHA release!
;; Breaking changes are possible!
;; Emacs provides the binding conditionals `if-let', `if-let*',
;; `when-let', `when-let*', `and-let*' and `while-let'.
;; This package implements the missing `and-let' and `while-let*',
;; and the original `cond-let', `cond-let*', `and$' and `and>'.
;; This package additionally provides more consistent and improved
;; implementations of the binding conditionals already provided by
;; Emacs. Merely loading this library does not shadow the built-in
;; implementations; this can optionally be done in the context of
;; an individual library, as described below.
;; `cond-let' and `cond-let*' are provided exactly under these names.
;; The names of all other macros implemented by this package begin
;; with `cond-let--', the package's prefix for private symbol.
;; Users of this package are not expected to use these unwieldy
;; names. Instead one should use Emacs' shorthand feature to use
;; all or some of these macros by their conceptual names. E.g., if
;; you want to use all of the available macros, add this at the end
;; of a library.
;; Local Variables:
;; read-symbol-shorthands: (
;; ("and$" . "cond-let--and$")
;; ("and>" . "cond-let--and>")
;; ("and-let" . "cond-let--and-let")
;; ("if-let" . "cond-let--if-let")
;; ("when-let" . "cond-let--when-let")
;; ("while-let" . "cond-let--while-let"))
;; End:
;; You can think of these file-local settings as import statements of
;; sorts. If you do this, then this package's implementations shadow
;; the built-in implementations. Doing so does not affect any other
;; libraries, which continue to use the built-in implementations.
;; Due to limitations of the shorthand implementation this has to be
;; done for each individual library. "dir-locals.el" cannot be used.
;; If you use `and$' and `and>', you might want to add this to your
;; configuration:
;; (with-eval-after-load 'cond-let
;; (font-lock-add-keywords 'emacs-lisp-mode
;; cond-let-font-lock-keywords t))
;; For information about the individual macros, please refer to their
;; docstrings.
;; See also https://github.com/tarsius/cond-let/wiki.
;;; Code:
;;; Cond
(defun cond-let--prepare-clauses (tag sequential clauses)
"Used by macros `cond-let*' and `cond-let'."
(let (body)
(dolist (clause (nreverse clauses))
(cond
((vectorp clause)
(setq body
`((,(if (and sequential (length> clause 1)) 'let* 'let)
,(mapcar (lambda (vec) (append vec nil)) clause)
,@body))))
((let (varlist)
(while (vectorp (car clause))
(push (append (pop clause) nil) varlist))
(push (cond
(varlist
`(,(pcase (list (and body t)
(and sequential (length> varlist 1)))
('(t t ) 'cond-let--when-let*)
(`(t ,_) 'cond-let--when-let)
('(nil t ) 'cond-let--and-let*)
(`(nil ,_) 'cond-let--and-let))
,(nreverse varlist)
,(if body
`(throw ',tag ,(macroexp-progn clause))
(macroexp-progn clause))))
((length= clause 1)
(if body
(let ((a (gensym "anon")))
`(let ((,a ,(car clause)))
(when ,a (throw ',tag ,a))))
(car clause)))
((and (eq (car clause) t) (not body))
(macroexp-progn (cdr clause)))
(t
`(when ,(pop clause)
(throw ',tag ,(macroexp-progn clause)))))
body)))))
body))
(defmacro cond-let* (&rest clauses)
"Try each clause until one succeeds.
Each clause has one of these forms:
- a plain clause (CONDITION BODY...)
- a binding clause ([SYMBOL VALUEFORM]... BODY...)
- a binding vector [[SYMBOL VALUEFORM]...]
A (CONDITION BODY...) clause works as for `cond'. Evaluate CONDITION,
and if it yields non-nil, the clause succeeds. Then evaluate BODY forms
sequentially and return the value of the last; or if there are no BODY
forms, return the value of CONDITION. If CONDITION yields nil, do not
evaluate the BODY forms and instead proceed to the next clause.
A ([SYMBOL VALUEFORM]... BODY...) clause begins with one or more binding
vectors, followed by one or more BODY forms. Bind SYMBOL to the value
of VALUEFORM. Each VALUEFORM can refer to symbols already bound by this
VARLIST (as for `let*').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and return the value of the last form.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and proceed to the next clause.
A [[SYMBOL VALUEFORM]...] form creates bindings, which extend to all
remaining clauses and binding vectors. Unlike for the previous form,
always bind all SYMBOLs, even if a VALUEFORM yields nil. Always proceed
to the next clause."
(declare (indent 0)
(debug (&rest [&or
(vector &rest (vector symbolp form))
([&rest (vector symbolp form)] body)
(form body)])))
(let ((tag (gensym ":cond-let*")))
`(catch ',tag
,@(cond-let--prepare-clauses tag t clauses))))
(defmacro cond-let (&rest clauses)
"Try each clause until one succeeds.
Each clause has one of these forms:
- a plain clause (CONDITION BODY...)
- a binding clause ([SYMBOL VALUEFORM]... BODY...)
- a binding vector [[SYMBOL VALUEFORM]...]
A (CONDITION BODY...) clause works as for `cond'. Evaluate CONDITION,
and if it yields non-nil, the clause succeeds. Then evaluate BODY forms
sequentially and return the value of the last; or if there are no BODY
forms, return the value of CONDITION. If CONDITION yields nil, do not
evaluate the BODY forms and instead proceed to the next clause.
A ([SYMBOL VALUEFORM]... BODY...) clause begins with one or more binding
vectors, followed by one or more BODY forms. Bind SYMBOL to the value
of VALUEFORM. Evaluate all VALUEFORMs before binding their respective
SYMBOLs (as for `let').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and return the value of the last form.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and proceed to the next clause.
A [[SYMBOL VALUEFORM]...] form creates bindings, which extend to all
remaining clauses and binding vectors. Evaluate all VALUEFORMs before
binding their respective SYMBOLs. Unlike for the previous form, bind
all SYMBOLs, even if a VALUEFORM yields nil. Always proceed to the
next clause."
(declare (indent 0) (debug cond-let*))
(let ((tag (gensym ":cond-let")))
`(catch ',tag
,@(cond-let--prepare-clauses tag nil clauses))))
;;; Common
(defun cond-let--prepare-varlist (varlist)
"Used by Cond-Let's `when-let*', `and-let*' and `while-let*'.
Also used by other macros via `cond-let--prepare-varforms'.
Return (VARLIST LASTVAR)."
(let (prevvar)
(list (mapcar (lambda (binding)
(unless (length= binding 2)
(signal 'error (cons "Invalid binding" binding)))
(pcase-let ((`(,var ,form) binding))
(when (string-prefix-p "_" (symbol-name var))
(setq var (gensym "anon")))
(prog1 (if prevvar
`(,var (and ,prevvar ,form))
(list var form))
(setq prevvar var))))
varlist)
prevvar)))
(defun cond-let--prepare-varforms (varlist &optional if-let)
"Used by Cond-Let's `when-let', `and-let', `while-let' and `if-let'.
Return (ANON-VARLIST ANON-SETQ VARLIST LASTVAR), or if the length of
VARLIST is 1 and IF-LET is nil, return (nil nil VARLIST LASTVAR)."
(if (and (not if-let)
(length= varlist 1))
`(nil nil ,@(cond-let--prepare-varlist varlist))
(let ((triples
(mapcar (lambda (binding)
(unless (length= binding 2)
(signal 'error (cons "Invalid binding" binding)))
(pcase-let ((`(,var ,form) binding))
(when (string-prefix-p "_" (symbol-name var))
(setq var nil))
(list (and var (gensym "anon"))
var
form)))
varlist)))
(list (mapcan (pcase-lambda (`(,anon ,_ ,_))
(and anon (list anon)))
triples)
(mapcar (pcase-lambda (`(,anon ,_ ,form))
(if anon
`(setq ,anon ,form)
form))
triples)
(mapcan (pcase-lambda (`(,anon ,var ,_))
(and var `((,var ,anon))))
triples)
(cadr (car (last triples)))))))
;;; And
(defmacro cond-let--and-let* (varlist &optional bodyform)
"Bind according to VARLIST until one yields nil, else evaluate BODYFORM.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Each VALUEFORM can refer to symbols already
bound by this VARLIST (as for `let*').
Evaluate VALUEFORMs until on of them yields nil. If that happens return
nil, and evaluate neither the remaining VALUEFORMs nor BODYFORM. If all
VALUEFORMs yield non-nil, evaluate BODYFORM with the bindings in effect,
and return its value; or if there is no BODYFORM, the value of the last
VALUEFORM."
(declare (indent 1)
(debug ((&rest (symbolp form)) form)))
(pcase-let ((`(,varlist ,lastvar)
(cond-let--prepare-varlist varlist)))
`(let* ,varlist
,(if bodyform
`(and ,lastvar ,bodyform)
lastvar))))
(defmacro cond-let--and-let (varlist &optional bodyform)
"Bind according to VARLIST until one yields nil, else evaluate BODYFORM.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Evaluate all VALUEFORMs before binding their
respective SYMBOLs (as for `let').
Evaluate VALUEFORMs until on of them yields nil. If that happens return
nil, and evaluate neither the remaining VALUEFORMs nor BODYFORM. If all
VALUEFORMs yield non-nil, evaluate BODYFORM with the bindings in effect,
and return its value; or if there is no BODYFORM, the value of the last
VALUEFORM."
(declare (indent 1) (debug cond-let--and-let*))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist)))
(cond (anon
`(let ,anon
(and ,@set
(let ,bind
,(or bodyform lastvar)))))
(t
`(let ,bind
,(if bodyform
`(and ,lastvar ,bodyform)
lastvar))))))
(defmacro cond-let--and$ (varform bodyform)
"Bind variable `$' to value of VARFORM and conditionally evaluate BODYFORM.
If VARFORM yields a non-nil value, bind the symbol `$' to that value,
evaluate BODYFORM with that binding in effect, and return the value of
BODYFORM. If VARFORM yields nil, do not evaluate BODYFORM, and return
nil."
(declare (debug (form form)))
`(let (($ ,varform))
(and $ ,bodyform)))
(defmacro cond-let--and> (form form2 &rest forms)
"Bind variables according to each VARFORM until one of them yields nil.
Evaluate the first FORM and if that yields a non-nil value, bind the
symbol `$' to that value, and evaluate the next FORM with that binding
in effect. Repeat this process with subsequent FORMs until one yields
nil, then return nil without evaluate the remaining FORMs. If all
FORMs yield non-nil, return the value of the last FORM.
\(fn FORM FORM...)"
(declare (debug (form form body)))
`(,(if forms 'let* 'let)
(($ ,form)
,@(and forms
(mapcar (lambda (form)
`($ (and $ ,form)))
(cons form2 (butlast forms)))))
(and $
,(or (car (last forms))
form2))))
;;; If
(defmacro cond-let--if-let* (varlist then &rest else)
"Bind variables according to VARLIST and evaluate THEN or ELSE.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Each VALUEFORM can refer to symbols already
bound by this VARLIST (as for `let*').
If all VALUEFORMs yield non-nil, evaluate THEN with VARLIST's bindings
in effect, and return its value. THEN must be one expression.
If any VALUEFORM yields nil, evaluate ELSE sequentially and return the
value of the last form; or if there are no ELSE forms return nil. The
bindings from VARLIST do _not_ extend to the ELSE forms.
\(fn VARLIST THEN [ELSE...])"
(declare (indent 2)
(debug ((&rest (symbolp form)) form body)))
(pcase-let ((`(,varlist ,lastvar)
(cond-let--prepare-varlist varlist))
(tag (gensym ":if-let*")))
`(catch ',tag
(let* ,varlist
(when ,lastvar
(throw ',tag ,then)))
,@else)))
(defmacro cond-let--if-let (varlist then &rest else)
"Bind variables according to VARLIST and evaluate THEN or ELSE.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Evaluate all VALUEFORMs before binding their
respective SYMBOLs (as for `let').
If all VALUEFORMs yield non-nil, evaluate THEN with VARLIST's bindings
in effect, and return its value. THEN must be one expression.
If any VALUEFORM yields nil, evaluate ELSE sequentially and return the
value of the last form; or if there are no ELSE forms return nil. The
bindings from VARLIST do _not_ extend to the ELSE forms.
\(fn VARLIST THEN [ELSE...])"
(declare (indent 2) (debug cond-let--if-let*))
(pcase-let* ((`(,anon ,set ,bind ,_)
(cond-let--prepare-varforms varlist t))
(set (if (length= set 1) (car set) (cons 'and set))))
`(let ,anon
(if ,set
(let ,bind
,then)
,@else))))
;;; When
(defmacro cond-let--when-let* (varlist bodyform &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Each VALUEFORM can refer to symbols already
bound by this VARLIST (as for `let*').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and return the value of the last form.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and instead return nil.
BODY must be one or more expressions. If VARLIST is empty, do nothing
and return nil.
\(fn VARLIST BODY...)"
(declare (indent 1)
(debug ((&rest (symbolp form)) form body)))
(pcase-let ((`(,varlist ,lastvar)
(cond-let--prepare-varlist varlist)))
`(let* ,varlist
(when ,lastvar
,bodyform ,@body))))
(defmacro cond-let--when-let (varlist bodyform &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Evaluate all VALUEFORMs before binding their
respective SYMBOLs (as for `let').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and return the value of the last form.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and instead return nil.
BODY must be one or more expressions. If VARLIST is empty, do nothing
and return nil.
\(fn VARLIST BODY...)"
(declare (indent 1) (debug cond-let--when-let*))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist)))
(cond (anon
`(let ,anon
(when (and ,@set)
(let ,bind
,bodyform ,@body))))
(t
`(let ,bind
(when ,lastvar
,bodyform ,@body))))))
(defmacro cond-let--when$ (varform bodyform &rest body)
"Bind variable `$' to value of VARFORM and conditionally evaluate BODY.
If VARFORM yields a non-nil value, bind the symbol `$' to that value,
evaluate BODY with that binding in effect, and return the value of the
last form. If VARFORM yields nil, do not evaluate BODY, and return nil.
BODY must be one or more expressions. If VARLIST is empty, do nothing
and return nil.
\(fn VARLIST BODY...)"
(declare (debug (form form)))
`(let (($ ,varform))
(when $
,bodyform ,@body)))
;;; While
(defmacro cond-let--while-let* (varlist &rest body)
"Bind variables according to VARLIST, conditionally evaluate BODY, and repeat.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Each VALUEFORM can refer to symbols already
bound by this VARLIST (as for `let*').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and repeat the loop.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and instead return, always yielding nil.
BODY can be zero or more expressions.
\(fn VARLIST [BODY...])"
(declare (indent 1) (debug cond-let--if-let*))
(pcase-let ((`(,varlist ,lastvar)
(cond-let--prepare-varlist varlist))
(tag (gensym ":while-let*")))
`(catch ',tag
(while t
(let* ,varlist
(if ,lastvar
,(macroexp-progn body)
(throw ',tag nil)))))))
(defmacro cond-let--while-let (varlist bodyform &rest body)
"Bind variables according to VARLIST, conditionally evaluate BODY, and repeat.
Each element of VARLIST is a list (SYMBOL VALUEFORM), which binds SYMBOL
to the value of VALUEFORM. Evaluate all VALUEFORMs before binding their
respective SYMBOLs (as for `let').
If all VALUEFORMs yield non-nil, evaluate BODY forms sequentially, with
VARLIST's bindings in effect, and repeat the loop.
If any VALUEFORM yields nil, evaluate neither the remaining VALUEFORMs
nor the BODY forms, and instead return, always yielding nil.
BODY can be one or more expressions.
\(fn VARLIST BODY...)"
(declare (indent 1) (debug cond-let--if-let*))
(pcase-let ((`(,anon ,set ,bind ,lastvar)
(cond-let--prepare-varforms varlist))
(tag (gensym ":while-let")))
(cond (anon
`(catch ',tag
(while t
(let ,anon
(if (and ,@set)
(let ,bind
,bodyform ,@body)
(throw ',tag nil))))))
(t
`(catch ',tag
(while t
(let ,bind
(if ,lastvar
,(macroexp-progn (cons bodyform body))
(throw ',tag nil)))))))))
;;; Font-Lock
(defvar cond-let-font-lock-keywords
'(("\\_<\\$\\_>" 0 'font-lock-variable-name-face))
"Highlight `$' using `font-lock-variable-name-face'.
To add these keywords, add this to your configuration:
\(font-lock-add-keywords \\='emacs-lisp-mode cond-let-font-lock-keywords t)")
(provide 'cond-let)
;;; cond-let.el ends here

Binary file not shown.

View File

@@ -0,0 +1,83 @@
;;; dash-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from dash.el
(autoload 'dash-fontify-mode "dash" "\
Toggle fontification of Dash special variables.
Dash-Fontify mode is a buffer-local minor mode intended for Emacs
Lisp buffers. Enabling it causes the special variables bound in
anaphoric Dash macros to be fontified. These anaphoras include
`it', `it-index', `acc', and `other'. In older Emacs versions
which do not dynamically detect macros, Dash-Fontify mode
additionally fontifies Dash macro calls.
See also `dash-fontify-mode-lighter' and
`global-dash-fontify-mode'.
This is a minor mode. If called interactively, toggle the `Dash-Fontify
mode' mode. If the prefix argument is positive, enable the mode, and if
it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the mode
if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate the variable `dash-fontify-mode'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
(fn &optional ARG)" t)
(put 'global-dash-fontify-mode 'globalized-minor-mode t)
(defvar global-dash-fontify-mode nil "\
Non-nil if Global Dash-Fontify mode is enabled.
See the `global-dash-fontify-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `global-dash-fontify-mode'.")
(custom-autoload 'global-dash-fontify-mode "dash" nil)
(autoload 'global-dash-fontify-mode "dash" "\
Toggle Dash-Fontify mode in all buffers.
With prefix ARG, enable Global Dash-Fontify mode if ARG is positive;
otherwise, disable it.
If called from Lisp, toggle the mode if ARG is `toggle'.
Enable the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
Dash-Fontify mode is enabled in all buffers where
`dash--turn-on-fontify-mode' would do it.
See `dash-fontify-mode' for more information on Dash-Fontify mode.
(fn &optional ARG)" t)
(autoload 'dash-register-info-lookup "dash" "\
Register the Dash Info manual with `info-lookup-symbol'.
This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t)
(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-"))
;;; End of scraped data
(provide 'dash-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; dash-autoloads.el ends here

View File

@@ -0,0 +1,10 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "dash" "20250312.1307"
"A modern list library for Emacs."
'((emacs "24"))
:url "https://github.com/magnars/dash.el"
:commit "fcb5d831fc08a43f984242c7509870f30983c27c"
:revdesc "fcb5d831fc08"
:keywords '("extensions" "lisp")
:authors '(("Magnar Sveen" . "magnars@gmail.com"))
:maintainers '(("Basil L. Contovounesios" . "basil@contovou.net")))

File diff suppressed because it is too large Load Diff

Binary file not shown.

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Dash: (dash.info). A modern list library for GNU Emacs.

View File

@@ -0,0 +1,434 @@
# EmacSQL
EmacSQL is a high-level Emacs Lisp front-end for SQLite.
PostgreSQL and MySQL are also supported, but use of these connectors
is not recommended.
Any [readable lisp value][readable] can be stored as a value in
EmacSQL, including numbers, strings, symbols, lists, vectors, and
closures. EmacSQL has no concept of "TEXT" values; it's all just lisp
objects. The lisp object `nil` corresponds 1:1 with `NULL` in the
database.
Requires Emacs 26 or later.
[![Compile](https://github.com/magit/emacsql/actions/workflows/compile.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/compile.yml)
[![Test](https://github.com/magit/emacsql/actions/workflows/test.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/test.yml)
[![NonGNU ELPA](https://emacsair.me/assets/badges/nongnu-elpa.svg)](https://elpa.nongnu.org/nongnu-devel/emacsql.html)
[![MELPA Stable](https://stable.melpa.org/packages/emacsql-badge.svg)](https://stable.melpa.org/#/emacsql)
[![MELPA](https://melpa.org/packages/emacsql-badge.svg)](https://melpa.org/#/emacsql)
### FAQ
#### Why are all values stored as strings?
EmacSQL is not intended to interact with arbitrary databases, but to
be an ACID-compliant database for Emacs extensions. This means that
EmacSQL cannot be used with a regular SQL database used by other
non-Emacs clients.
All database values must be s-expressions. When EmacSQL stores a
value — string, symbol, cons, etc. — it is printed and written to
the database in its printed form. Strings are wrapped in quotes
and escaped as necessary. That means "bare" symbols in the database
generally look like strings. The only exception is `nil`, which is
stored as `NULL`.
#### Will EmacSQL ever support arbitrary databases?
The author of EmacSQL [thinks][mistake] that it was probably a
design mistake to restrict it to Emacs by storing only printed values,
and that it would be a lot more useful if it just handled primitive
database types.
However, EmacSQL is in maintenance mode and there are no plans to
make any fundamental changes, not least because they would break all
existing packages and databases that rely on the current EmacSQL
behavior.
### Windows Issues
Emacs `start-process-shell-command` function is not supported on
Windows. Since both `emacsql-mysql` and `emacsql-psql` rely on this
function, neither of these connection types are supported on Windows.
## Example Usage
```el
(defvar db (emacsql-sqlite-open "~/company.db"))
;; Create a table. Table and column identifiers are symbols.
(emacsql db [:create-table people ([name id salary])])
;; Or optionally provide column constraints.
(emacsql db [:create-table people
([name (id integer :primary-key) (salary float)])])
;; Insert some data:
(emacsql db [:insert :into people
:values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])])
;; Query the database for results:
(emacsql db [:select [name id]
:from people
:where (> salary 62000)])
;; => (("Susan" 1001))
;; Queries can be templates, using $1, $2, etc.:
(emacsql db [:select [name id]
:from people
:where (> salary $s1)]
50000)
;; => (("Jeff" 1000) ("Susan" 1001))
```
When editing these prepared SQL s-expression statements, the `M-x
emacsql-show-last-sql` command (think `eval-last-sexp`) is useful for
seeing what the actual SQL expression will become when compiled.
## Schema
A table schema is a list whose first element is a vector of column
specifications. The rest of the list specifies table constraints. A
column identifier is a symbol and a column's specification can either
be just this symbol or it can include constraints as a list. Because
EmacSQL stores entire lisp objects as values, the only relevant (and
allowed) types are `integer`, `float`, and `object` (default).
([(<column>) ...] (<table-constraint> ...) ...])
Dashes in identifiers are converted into underscores when compiled
into SQL. This allows for lisp-style identifiers to be used in SQL.
Constraints follow the compilation rules below.
```el
;; No constraints schema with four columns:
([name id building room])
;; Add some column constraints:
([(name :unique) (id integer :primary-key) building room])
;; Add some table constraints:
([(name :unique) (id integer :primary-key) building room]
(:unique [building room])
(:check (> id 0)))
```
Here's an example using foreign keys.
```el
;; "subjects" table schema
([(id integer :primary-key) subject])
;; "tag" table references subjects
([(subject-id integer) tag]
(:foreign-key [subject-id] :references subjects [id]
:on-delete :cascade))
```
Foreign key constraints are enabled by default in EmacSQL.
## Operators
Expressions are written lisp-style, with the operator first. If it
looks like an operator EmacSQL treats it like an operator. However,
several operators are special.
<= >= funcall quote
The `<=` and `>=` operators accept 2 or 3 operands, transforming into
a SQL `_ BETWEEN _ AND _` operator as appropriate.
For function-like "operators" like `count` and `max` use the `funcall`
"operator."
```el
[:select (funcall max age) :from people]
```
With `glob` and `like` SQL operators keep in mind that they're
matching the *printed* representations of these values, even if the
value is a string.
The `||` concatenation operator is unsupported because concatenating
printed representations breaks an important constraint: all values must
remain readable within SQLite.
## Quoting
Inside expressions, EmacSQL cannot tell the difference between symbol
literals and column references. If you're talking about the symbol
itself, just quote it as you would in normal Elisp. Note that this
does not "escape" `$tn` parameter symbols.
```el
(emacsql db [... :where (= category 'hiking)])
```
Quoting a string makes EmacSQL handle it as a "raw string." These raw
strings are not printed when being assembled into a query. These are
intended for use in special circumstances like filenames (`ATTACH`) or
pattern matching (`LIKE`). It is vital that raw strings are not
returned as results.
```el
(emacsql db [... :where (like name '"%foo%")])
(emacsql db [:attach '"/path/to/foo.db" :as foo])
```
Since template parameters include their type they never need to be
quoted.
## Prepared Statements
The database is interacted with via prepared SQL s-expression
statements. You shouldn't normally be concatenating strings on your
own. (And it leaves out any possibility of a SQL injection!) See the
"Usage" section above for examples. A statement is a vector of
keywords and other lisp object.
Prepared EmacSQL s-expression statements are compiled into SQL
statements. The statement compiler is memorized so that using the same
statement multiple times is fast. To assist in this, the statement can
act as a template -- using `$i1`, `$s2`, etc. -- working like the
Elisp `format` function.
### Compilation Rules
Rather than the typical uppercase SQL keywords, keywords in a prepared
EmacSQL statement are literally just that: lisp keywords. EmacSQL only
understands a very small amount of SQL's syntax. The compiler follows
some simple rules to convert an s-expression into SQL.
#### All prepared statements are vectors.
A prepared s-expression statement is a vector beginning with a keyword
followed by a series of keywords and special values. This includes
most kinds of sub-queries.
```el
[:select ... :from ...]
[:select tag :from tags
:where (in tag [:select ...])]
```
#### Keywords are split and capitalized.
Dashes are converted into spaces and the keyword gets capitalized. For
example, `:if-not-exists` becomes `IF NOT EXISTS`. How you choose to
combine keywords is up to your personal taste (e.g., `:drop :table` vs.
`:drop-table`).
#### Standalone symbols are identifiers.
EmacSQL doesn't know what symbols refer to identifiers and what
symbols should be treated as values. Use quotes to mark a symbol as a
value. For example, `people` here will be treated as an identifier.
```el
[:insert-into people :values ...]
```
#### Row-oriented information is always represented as vectors.
This includes rows being inserted, and sets of columns in a query. If
you're talking about a row-like thing then put it in a vector.
```el
[:select [id name] :from people]
```
Note that `*` is actually a SQL keyword, so don't put it in a vector.
```el
[:select * :from ...]
```
#### Lists are treated as expressions.
This is true even within row-oriented vectors.
```el
[... :where (= name "Bob")]
[:select [(/ seconds 60) count] :from ...]
```
Some things that are traditionally keywords -- particularly those that
are mixed in with expressions -- have been converted into operators
(`AS`, `ASC`, `DESC`).
```el
[... :order-by [(asc b), (desc a)]] ; "ORDER BY b ASC, a DESC"
[:select p:name :from (as people p)] ; "SELECT p.name FROM people AS p"
```
#### The `:values` keyword is special.
What follows `:values` is always treated like a vector or list of
vectors. Normally this sort of thing would appear to be a column
reference.
```el
[... :values [1 2 3]]
[... :values ([1 2 3] [4 5 6])] ; insert multiple rows
```
#### A list whose first element is a vector is a table schema.
This is to distinguish schemata from everything else. With the
exception of what follows `:values`, nothing else is shaped like this.
```el
[:create-table people ([(id :primary-key) name])]
```
### Templates
To make statement compilation faster, and to avoid making you build up
statements dynamically, you can insert `$tn` parameters in place of
identifiers and values. These refer to the argument's type and its
argument position after the statement in the `emacsql` function,
one-indexed.
```el
(emacsql db [:select * :from $i1 :where (> salary $s2)] 'employees 50000)
(emacsql db [:select * :from employees :where (like name $r1)] "%Smith%")
```
The letter before the number is the type.
* `i` : identifier
* `s` : scalar
* `v` : vector (or multiple vectors)
* `r` : raw, unprinted strings
* `S` : schema
When combined with `:values`, the vector type can refer to lists of
rows.
```el
(emacsql db [:insert-into favorite-characters :values $v1]
'([0 "Calvin"] [1 "Hobbes"] [3 "Susie"]))
```
This is why rows must be vectors and not lists.
### Ignored Features
EmacSQL doesn't cover all of SQLite's features. Here are a list of
things that aren't supported, and probably will never be.
* Collating. SQLite has three built-in collation functions: BINARY
(default), NOCASE, and RTRIM. EmacSQL values never have right-hand
whitespace, so RTRIM won't be of any use. NOCASE is broken
(ASCII-only) and there's little reason to use it.
* Text manipulation functions. Like collating this is incompatible
with EmacSQL s-expression storage.
* Date and time. These are incompatible with the printed values
stored by EmacSQL and therefore have little use.
## Limitations
EmacSQL is *not* intended to play well with other programs accessing
the SQLite database. Non-numeric values are stored encoded as
s-expressions TEXT values. This avoids ambiguities in parsing output
from the command line and allows for storage of Emacs richer data
types. This is an efficient, ACID-compliant database specifically for
Emacs.
## Emacs Lisp Indentation Annoyance
By default, `emacs-lisp-mode` indents vectors as if they were regular
function calls.
```el
;; Ugly indentation!
(emacsql db [:select *
:from people
:where (> age 60)])
```
Calling the function `emacsql-fix-vector-indentation` (interactive)
advises the major mode to fix this annoyance.
```el
;; Such indent!
(emacsql db [:select *
:from people
:where (> age 60)])
```
## Contributing and Extending
To run the test suite, clone the `pg` and `sqlite3` packages into
sibling directories. The Makefile will automatically put these paths on
the Emacs load path (override `LDFLAGS` if your situation is different).
```shell
git clone https://github.com/emarsden/pg-el ../pg
git clone https://github.com/pekingduck/emacs-sqlite3-api ../sqlite3
```
Or set `LOAD_PATH` to point at these packages elsewhere:
```shell
make LOAD_PATH='-L path/to/pg -L path/to/sqlite3'
```
Then invoke make:
```shell
make test
```
If the environment variable `PGDATABASE` is present then the unit
tests will also be run with PostgreSQL (emacsql-psql). Provide
`PGHOST`, `PGPORT`, and `PGUSER` if needed. If `PGUSER` is provided,
the pg.el back-end (emacsql-pg) will also be tested.
If the environment variable `MYSQL_DBNAME` is present then the unit
tests will also be run with MySQL in the named database. Note that
this is not an official MySQL variable, just something made up for
EmacSQL.
### Creating a New Front-end
EmacSQL uses EIEIO so that interactions with a connection occur
through generic functions. You need to define a new class that
inherits from `emacsql-connection`.
* Implement `emacsql-send-message`, `emacsql-waiting-p`,
`emacsql-parse`, and `emacsql-close`.
* Provide a constructor that initializes the connection and calls
`emacsql-register` (for automatic connection cleanup).
* Provide `emacsql-types` if needed (hint: use a class-allocated slot).
* Ensure that you properly read NULL as nil (hint: ask your back-end
to print it that way).
* Register all reserved words with `emacsql-register-reserved`.
* Preferably provide `emacsql-reconnect` if possible.
* Set the default isolation level to *serializable*.
* Enable autocommit mode by default.
* Prefer ANSI syntax (value escapes, identifier escapes, etc.).
* Enable foreign key constraints by default.
The goal of the autocommit, isolation, parsing, and foreign key
configuration settings is to normalize the interface as much as
possible. The connection's user should have the option to be agnostic
about which back-end is actually in use.
The provided implementations should serve as useful examples. If your
back-end outputs data in a clean, standard way you may be able to use
the emacsql-protocol-mixin class to do most of the work.
## See Also
* [SQLite Documentation](https://www.sqlite.org/docs.html)
[readable]: http://nullprogram.com/blog/2013/12/30/#almost_everything_prints_readably
[mistake]: https://github.com/magit/emacsql/issues/35#issuecomment-346352439
<!-- LocalWords: EIEIO Elisp EmacSQL MELPA Makefile NOCASE RTRIM -->
<!-- LocalWords: SQL's autocommit el emacsql unprinted whitespace -->

View File

@@ -0,0 +1,68 @@
;;; emacsql-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from emacsql.el
(autoload 'emacsql-show-last-sql "emacsql" "\
Display the compiled SQL of the s-expression SQL expression before point.
A prefix argument causes the SQL to be printed into the current buffer.
(fn &optional PREFIX)" t)
(register-definition-prefixes "emacsql" '("emacsql-"))
;;; Generated autoloads from emacsql-compiler.el
(register-definition-prefixes "emacsql-compiler" '("emacsql-"))
;;; Generated autoloads from emacsql-mysql.el
(register-definition-prefixes "emacsql-mysql" '("emacsql-mysql-"))
;;; Generated autoloads from emacsql-pg.el
(register-definition-prefixes "emacsql-pg" '("emacsql-pg-connection"))
;;; Generated autoloads from emacsql-psql.el
(register-definition-prefixes "emacsql-psql" '("emacsql-psql-"))
;;; Generated autoloads from emacsql-sqlite.el
(register-definition-prefixes "emacsql-sqlite" '("emacsql-"))
;;; Generated autoloads from emacsql-sqlite-builtin.el
(register-definition-prefixes "emacsql-sqlite-builtin" '("emacsql-sqlite-builtin-connection"))
;;; Generated autoloads from emacsql-sqlite-module.el
(register-definition-prefixes "emacsql-sqlite-module" '("emacsql-sqlite-module-connection"))
;;; End of scraped data
(provide 'emacsql-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; emacsql-autoloads.el ends here

View File

@@ -0,0 +1,546 @@
;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides support for compiling S-expressions to SQL.
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
;;; Error symbols
(defmacro emacsql-deferror (symbol parents message)
"Defines a new error symbol for EmacSQL."
(declare (indent 2))
(let ((conditions (cl-remove-duplicates
(append parents (list symbol 'emacsql-error 'error)))))
`(prog1 ',symbol
(put ',symbol 'error-conditions ',conditions)
(put ',symbol 'error-message ,message))))
(emacsql-deferror emacsql-error () ;; parent condition for all others
"EmacSQL had an unhandled condition")
(emacsql-deferror emacsql-syntax () "Invalid SQL statement")
(emacsql-deferror emacsql-internal () "Internal error")
(emacsql-deferror emacsql-locked () "Database locked")
(emacsql-deferror emacsql-fatal () "Fatal error")
(emacsql-deferror emacsql-memory () "Out of memory")
(emacsql-deferror emacsql-corruption () "Database corrupted")
(emacsql-deferror emacsql-access () "Database access error")
(emacsql-deferror emacsql-timeout () "Query timeout error")
(emacsql-deferror emacsql-warning () "Warning message")
(defun emacsql-error (format &rest args)
"Like `error', but signal an emacsql-syntax condition."
(signal 'emacsql-syntax (list (apply #'format format args))))
;;; Escaping functions
(defvar emacsql-reserved (make-hash-table :test 'equal)
"Collection of all known reserved words, used for escaping.")
(defun emacsql-register-reserved (seq)
"Register sequence of keywords as reserved words, returning SEQ."
(cl-loop for word being the elements of seq
do (setf (gethash (upcase (format "%s" word)) emacsql-reserved) t)
finally (cl-return seq)))
(defun emacsql-reserved-p (name)
"Returns non-nil if string NAME is a SQL keyword."
(gethash (upcase name) emacsql-reserved))
(defun emacsql-quote-scalar (string)
"Single-quote (scalar) STRING for use in a SQL expression."
(with-temp-buffer
(insert string)
(goto-char (point-min))
(while (re-search-forward "'" nil t)
(replace-match "''"))
(goto-char (point-min))
(insert "'")
(goto-char (point-max))
(insert "'")
(buffer-string)))
(defun emacsql-quote-character (c)
"Single-quote character C for use in a SQL expression."
(if (char-equal c ?')
"''''"
(format "'%c'" c)))
(defun emacsql-quote-identifier (string)
"Double-quote (identifier) STRING for use in a SQL expression."
(format "\"%s\"" (replace-regexp-in-string "\"" "\"\"" string)))
(defun emacsql-escape-identifier (identifier)
"Escape an identifier, if needed, for SQL."
(when (or (null identifier)
(keywordp identifier)
(not (or (symbolp identifier)
(vectorp identifier))))
(emacsql-error "Invalid identifier: %S" identifier))
(cond
((vectorp identifier)
(mapconcat #'emacsql-escape-identifier identifier ", "))
((eq identifier '*) "*")
(t
(let ((name (symbol-name identifier)))
(if (string-match-p ":" name)
(mapconcat #'emacsql-escape-identifier
(mapcar #'intern (split-string name ":")) ".")
(let ((print (replace-regexp-in-string "-" "_" (format "%S" identifier)))
(special "[]-\000-\040!\"#%&'()*+,./:;<=>?@[\\^`{|}~\177]"))
(if (or (string-match-p special print)
(string-match-p "^[0-9$]" print)
(emacsql-reserved-p print))
(emacsql-quote-identifier print)
print)))))))
(defvar print-escape-control-characters)
(defun emacsql-escape-scalar (value)
"Escape VALUE for sending to SQLite."
(let ((print-escape-newlines t)
(print-escape-control-characters t))
(cond ((null value) "NULL")
((numberp value) (prin1-to-string value))
((emacsql-quote-scalar (prin1-to-string value))))))
(defun emacsql-escape-raw (value)
"Escape VALUE for sending to SQLite."
(cond ((null value) "NULL")
((stringp value) (emacsql-quote-scalar value))
((error "Expected string or nil"))))
(defun emacsql-escape-vector (vector)
"Encode VECTOR into a SQL vector scalar."
(cl-typecase vector
(null (emacsql-error "Empty SQL vector expression"))
(list (mapconcat #'emacsql-escape-vector vector ", "))
(vector (concat "(" (mapconcat #'emacsql-escape-scalar vector ", ") ")"))
(otherwise (emacsql-error "Invalid vector %S" vector))))
(defun emacsql-escape-format (thing)
"Escape THING for use as a `format' spec."
(replace-regexp-in-string "%" "%%" thing))
;;; Schema compiler
(defvar emacsql-type-map
'((integer "&INTEGER")
(float "&REAL")
(object "&TEXT")
(nil "&NONE"))
"An alist mapping EmacSQL types to SQL types.")
(defun emacsql--from-keyword (keyword)
"Convert KEYWORD into SQL."
(let ((name (substring (symbol-name keyword) 1)))
(upcase (replace-regexp-in-string "-" " " name))))
(defun emacsql--prepare-constraints (constraints)
"Compile CONSTRAINTS into a partial SQL expression."
(mapconcat
#'identity
(cl-loop for constraint in constraints collect
(cl-typecase constraint
(null "NULL")
(keyword (emacsql--from-keyword constraint))
(symbol (emacsql-escape-identifier constraint))
(vector (format "(%s)"
(mapconcat
#'emacsql-escape-identifier
constraint
", ")))
(list (format "(%s)"
(car (emacsql--*expr constraint))))
(otherwise
(emacsql-escape-scalar constraint))))
" "))
(defun emacsql--prepare-column (column)
"Convert COLUMN into a partial SQL string."
(mapconcat
#'identity
(cl-etypecase column
(symbol (list (emacsql-escape-identifier column)
(cadr (assoc nil emacsql-type-map))))
(list (cl-destructuring-bind (name . constraints) column
(cl-delete-if
(lambda (s) (zerop (length s)))
(list (emacsql-escape-identifier name)
(if (member (car constraints) '(integer float object))
(cadr (assoc (pop constraints) emacsql-type-map))
(cadr (assoc nil emacsql-type-map)))
(emacsql--prepare-constraints constraints))))))
" "))
(defun emacsql-prepare-schema (schema)
"Compile SCHEMA into a SQL string."
(if (vectorp schema)
(emacsql-prepare-schema (list schema))
(cl-destructuring-bind (columns . constraints) schema
(mapconcat
#'identity
(nconc
(mapcar #'emacsql--prepare-column columns)
(mapcar #'emacsql--prepare-constraints constraints))
", "))))
;;; Statement compilation
(defvar emacsql-prepare-cache (make-hash-table :test 'equal :weakness 'key)
"Cache used to memoize `emacsql-prepare'.")
(defvar emacsql--vars ()
"Used within `emacsql-with-params' to collect parameters.")
(defun emacsql-sql-p (thing)
"Return non-nil if THING looks like a prepared statement."
(and (vectorp thing) (> (length thing) 0) (keywordp (aref thing 0))))
(defun emacsql-param (thing)
"Return the index and type of THING, or nil if THING is not a parameter.
A parameter is a symbol that looks like $i1, $s2, $v3, etc. The
letter refers to the type: identifier (i), scalar (s),
vector (v), raw string (r), schema (S)."
(and (symbolp thing)
(let ((name (symbol-name thing)))
(and (string-match-p "^\\$[isvrS][0-9]+$" name)
(cons (1- (read (substring name 2)))
(cl-ecase (aref name 1)
(?i :identifier)
(?s :scalar)
(?v :vector)
(?r :raw)
(?S :schema)))))))
(defmacro emacsql-with-params (prefix &rest body)
"Evaluate BODY, collecting parameters.
Provided local functions: `param', `identifier', `scalar', `raw',
`svector', `expr', `subsql', and `combine'. BODY should return a
string, which will be combined with variable definitions."
(declare (indent 1))
`(let ((emacsql--vars ()))
(cl-flet* ((combine (prepared) (emacsql--*combine prepared))
(param (thing) (emacsql--!param thing))
(identifier (thing) (emacsql--!param thing :identifier))
(scalar (thing) (emacsql--!param thing :scalar))
(raw (thing) (emacsql--!param thing :raw))
(svector (thing) (combine (emacsql--*vector thing)))
(expr (thing) (combine (emacsql--*expr thing)))
(subsql (thing)
(format "(%s)" (combine (emacsql-prepare thing)))))
(cons (concat ,prefix (progn ,@body)) emacsql--vars))))
(defun emacsql--!param (thing &optional kind)
"Parse, escape, and store THING.
If optional KIND is not specified, then try to guess it.
Only use within `emacsql-with-params'!"
(cl-flet ((check (param)
(when (and kind (not (eq kind (cdr param))))
(emacsql-error
"Invalid parameter type %s, expecting %s" thing kind))))
(let ((param (emacsql-param thing)))
(if (null param)
(emacsql-escape-format
(if kind
(cl-case kind
(:identifier (emacsql-escape-identifier thing))
(:scalar (emacsql-escape-scalar thing))
(:vector (emacsql-escape-vector thing))
(:raw (emacsql-escape-raw thing))
(:schema (emacsql-prepare-schema thing)))
(if (and (not (null thing))
(not (keywordp thing))
(symbolp thing))
(emacsql-escape-identifier thing)
(emacsql-escape-scalar thing))))
(prog1 (if (eq (cdr param) :schema) "(%s)" "%s")
(check param)
(setq emacsql--vars (nconc emacsql--vars (list param))))))))
(defun emacsql--*vector (vector)
"Prepare VECTOR."
(emacsql-with-params ""
(cl-typecase vector
(symbol (emacsql--!param vector :vector))
(list (mapconcat #'svector vector ", "))
(vector (format "(%s)" (mapconcat #'scalar vector ", ")))
(otherwise (emacsql-error "Invalid vector: %S" vector)))))
(defmacro emacsql--generate-op-lookup-defun (name operator-precedence-groups)
"Generate function to look up predefined SQL operator metadata.
The generated function is bound to NAME and accepts two
arguments, OPERATOR-NAME and OPERATOR-ARGUMENT-COUNT.
OPERATOR-PRECEDENCE-GROUPS should be a number of lists containing
operators grouped by operator precedence (in order of precedence
from highest to lowest). A single operator is represented by a
list of at least two elements: operator name (symbol) and
operator arity (:unary or :binary). Optionally a custom
expression can be included, which defines how the operator is
expanded into an SQL expression (there are two defaults, one for
:unary and one for :binary operators).
An example for OPERATOR-PRECEDENCE-GROUPS:
\(((+ :unary (\"+\" :operand)) (- :unary (\"-\" :operand)))
((+ :binary) (- :binary)))"
`(defun ,name (operator-name operator-argument-count)
"Look up predefined SQL operator metadata.
See `emacsql--generate-op-lookup-defun' for details."
(cond
,@(cl-loop
for precedence-value from 1
for precedence-group in (reverse operator-precedence-groups)
append (cl-loop
for (op-name arity custom-expr) in precedence-group
for sql-name = (upcase (symbol-name op-name))
for sql-expr =
(or custom-expr
(pcase arity
(:unary `(,sql-name " " :operand))
(:binary `(:operand " " ,sql-name " " :operand))))
collect (list `(and (eq operator-name
(quote ,op-name))
,(if (eq arity :unary)
`(eql operator-argument-count 1)
`(>= operator-argument-count 2)))
`(list ',sql-expr ,arity ,precedence-value))))
(t (list nil nil nil)))))
(emacsql--generate-op-lookup-defun
emacsql--get-op
(((~ :unary ("~" :operand)))
((collate :binary))
((|| :binary))
((* :binary) (/ :binary) (% :binary))
((+ :unary ("+" :operand)) (- :unary ("-" :operand)))
((+ :binary) (- :binary))
((& :binary) (| :binary) (<< :binary) (>> :binary))
((escape :binary (:operand " ESCAPE " :operand)))
((< :binary) (<= :binary) (> :binary) (>= :binary))
(;;TODO? (between :binary) (not-between :binary)
(is :binary) (is-not :binary (:operand " IS NOT " :operand))
(match :binary) (not-match :binary (:operand " NOT MATCH " :operand))
(like :binary) (not-like :binary (:operand " NOT LIKE " :operand))
(in :binary) (not-in :binary (:operand " NOT IN " :operand))
(isnull :unary (:operand " ISNULL"))
(notnull :unary (:operand " NOTNULL"))
(= :binary) (== :binary)
(!= :binary) (<> :binary)
(glob :binary) (not-glob :binary (:operand " NOT GLOB " :operand))
(regexp :binary) (not-regexp :binary (:operand " NOT REGEXP " :operand)))
((not :unary))
((and :binary))
((or :binary))))
(defun emacsql--expand-format-string (op expr arity argument-count)
"Create format-string for an SQL operator.
The format-string returned is intended to be used with `format'
to create an SQL expression."
(and expr
(cl-labels ((replace-operand (x) (if (eq x :operand) "%s" x))
(to-format-string (e) (mapconcat #'replace-operand e "")))
(cond
((and (eq arity :unary) (eql argument-count 1))
(to-format-string expr))
((and (eq arity :binary) (>= argument-count 2))
(let ((result (reverse expr)))
(dotimes (_ (- argument-count 2))
(setq result (nconc (reverse expr) (cdr result))))
(to-format-string (nreverse result))))
(t (emacsql-error "Wrong number of operands for %s" op))))))
(defun emacsql--get-op-info (op argument-count parent-precedence-value)
"Lookup SQL operator information for generating an SQL expression.
Returns the following multiple values when an operator can be
identified: a format string (see `emacsql--expand-format-string')
and a precedence value. If PARENT-PRECEDENCE-VALUE is greater or
equal to the identified operator's precedence, then the format
string returned is wrapped with parentheses."
(cl-destructuring-bind (format-string arity precedence-value)
(emacsql--get-op op argument-count)
(let ((expanded-format-string
(emacsql--expand-format-string
op
format-string
arity
argument-count)))
(cl-values (cond
((null format-string) nil)
((>= parent-precedence-value
precedence-value)
(format "(%s)" expanded-format-string))
(t expanded-format-string))
precedence-value))))
(defun emacsql--*expr (expr &optional parent-precedence-value)
"Expand EXPR recursively."
(emacsql-with-params ""
(cond
((emacsql-sql-p expr) (subsql expr))
((vectorp expr) (svector expr))
((atom expr) (param expr))
((cl-destructuring-bind (op . args) expr
(cl-multiple-value-bind (format-string precedence-value)
(emacsql--get-op-info op
(length args)
(or parent-precedence-value 0))
(cl-flet ((recur (n)
(combine (emacsql--*expr (nth n args)
(or precedence-value 0))))
(nops (op)
(emacsql-error "Wrong number of operands for %s" op)))
(cl-case op
;; Special cases <= >=
((<= >=)
(cl-case (length args)
(2 (format format-string (recur 0) (recur 1)))
(3 (format (if (>= (or parent-precedence-value 0)
precedence-value)
"(%s BETWEEN %s AND %s)"
"%s BETWEEN %s AND %s")
(recur 1)
(recur (if (eq op '>=) 2 0))
(recur (if (eq op '>=) 0 2))))
(otherwise (nops op))))
;; enforce second argument to be a character
((escape)
(let ((second-arg (cadr args)))
(cond
((not (= 2 (length args))) (nops op))
((not (characterp second-arg))
(emacsql-error
"Second operand of escape has to be a character, got %s"
second-arg))
(t (format format-string
(recur 0)
(emacsql-quote-character second-arg))))))
;; Ordering
((asc desc)
(format "%s %s" (recur 0) (upcase (symbol-name op))))
;; Special case quote
((quote) (let ((arg (nth 0 args)))
(if (stringp arg)
(raw arg)
(scalar arg))))
;; Special case funcall
((funcall)
(format "%s(%s)" (recur 0)
(cond
((and (= 2 (length args))
(eq '* (nth 1 args)))
"*")
((and (= 3 (length args))
(eq :distinct (nth 1 args))
(format "DISTINCT %s" (recur 2))))
((mapconcat
#'recur (cl-loop for i from 1 below (length args)
collect i)
", ")))))
;; Guess
(otherwise
(let ((arg-indices (cl-loop for i from 0 below (length args) collect i)))
(if format-string
(apply #'format format-string (mapcar #'recur arg-indices))
(mapconcat
#'recur (cl-loop for i from 0 below (length args) collect i)
(format " %s " (upcase (symbol-name op)))))))))))))))
(defun emacsql--*idents (idents)
"Read in a vector of IDENTS identifiers, or just an single identifier."
(emacsql-with-params ""
(mapconcat #'expr idents ", ")))
(defun emacsql--*combine (prepared)
"Append parameters from PREPARED to `emacsql--vars', return the string.
Only use within `emacsql-with-params'!"
(cl-destructuring-bind (string . vars) prepared
(setq emacsql--vars (nconc emacsql--vars vars))
string))
(defun emacsql-prepare--string (string)
"Create a prepared statement from STRING."
(emacsql-with-params ""
(replace-regexp-in-string
"\\$[isv][0-9]+" (lambda (v) (param (intern v))) string)))
(defun emacsql-prepare--sexp (sexp)
"Create a prepared statement from SEXP."
(emacsql-with-params ""
(cl-loop with items = (cl-coerce sexp 'list)
and last = nil
while (not (null items))
for item = (pop items)
collect
(cl-typecase item
(keyword (if (eq :values item)
(concat "VALUES " (svector (pop items)))
(emacsql--from-keyword item)))
(symbol (if (eq item '*)
"*"
(param item)))
(vector (if (emacsql-sql-p item)
(subsql item)
(let ((idents (combine
(emacsql--*idents item))))
(if (keywordp last)
idents
(format "(%s)" idents)))))
(list (if (vectorp (car item))
(emacsql-escape-format
(format "(%s)"
(emacsql-prepare-schema item)))
(combine (emacsql--*expr item))))
(otherwise
(emacsql-escape-format
(emacsql-escape-scalar item))))
into parts
do (setq last item)
finally (cl-return (string-join parts " ")))))
(defun emacsql-prepare (sql)
"Expand SQL (string or sexp) into a prepared statement."
(let* ((cache emacsql-prepare-cache)
(key (cons emacsql-type-map sql)))
(or (gethash key cache)
(setf (gethash key cache)
(if (stringp sql)
(emacsql-prepare--string sql)
(emacsql-prepare--sexp sql))))))
(defun emacsql-format (expansion &rest args)
"Fill in the variables EXPANSION with ARGS."
(cl-destructuring-bind (format . vars) expansion
(let ((print-level nil)
(print-length nil))
(apply #'format format
(cl-loop for (i . kind) in vars collect
(let ((thing (nth i args)))
(cl-case kind
(:identifier (emacsql-escape-identifier thing))
(:scalar (emacsql-escape-scalar thing))
(:vector (emacsql-escape-vector thing))
(:raw (emacsql-escape-raw thing))
(:schema (emacsql-prepare-schema thing))
(otherwise
(emacsql-error "Invalid var type %S" kind)))))))))
(provide 'emacsql-compiler)
;;; emacsql-compiler.el ends here

Binary file not shown.

View File

@@ -0,0 +1,132 @@
;;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for MySQL, which uses
;; the standard `msql' command line program.
;;; Code:
(require 'emacsql)
(defvar emacsql-mysql-executable "mysql"
"Path to the mysql command line executable.")
(defvar emacsql-mysql-sentinel "--------------\n\n--------------\n\n"
"What MySQL will print when it has completed its output.")
(defconst emacsql-mysql-reserved
(emacsql-register-reserved
'( ACCESSIBLE ADD ALL ALTER ANALYZE AND AS ASC ASENSITIVE BEFORE
BETWEEN BIGINT BINARY BLOB BOTH BY CALL CASCADE CASE CHANGE CHAR
CHARACTER CHECK COLLATE COLUMN CONDITION CONSTRAINT CONTINUE
CONVERT CREATE CROSS CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP
CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR DAY_MICROSECOND
DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED DELETE
DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DROP
DUAL EACH ELSE ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE
FETCH FLOAT FLOAT4 FLOAT8 FOR FORCE FOREIGN FROM FULLTEXT GENERAL
GRANT GROUP HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE
HOUR_SECOND IF IGNORE IGNORE_SERVER_IDS IN INDEX INFILE INNER
INOUT INSENSITIVE INSERT INT INT1 INT2 INT3 INT4 INT8 INTEGER
INTERVAL INTO IS ITERATE JOIN KEY KEYS KILL LEADING LEAVE LEFT
LIKE LIMIT LINEAR LINES LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG
LONGBLOB LONGTEXT LOOP LOW_PRIORITY MASTER_HEARTBEAT_PERIOD
MASTER_SSL_VERIFY_SERVER_CERT MATCH MAXVALUE MAXVALUE MEDIUMBLOB
MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND
MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON
OPTIMIZE OPTION OPTIONALLY OR ORDER OUT OUTER OUTFILE PRECISION
PRIMARY PROCEDURE PURGE RANGE READ READS READ_WRITE REAL
REFERENCES REGEXP RELEASE RENAME REPEAT REPLACE REQUIRE RESIGNAL
RESIGNAL RESTRICT RETURN REVOKE RIGHT RLIKE SCHEMA SCHEMAS
SECOND_MICROSECOND SELECT SENSITIVE SEPARATOR SET SHOW SIGNAL
SIGNAL SLOW SMALLINT SPATIAL SPECIFIC SQL SQL_BIG_RESULT
SQL_CALC_FOUND_ROWS SQLEXCEPTION SQL_SMALL_RESULT SQLSTATE
SQLWARNING SSL STARTING STRAIGHT_JOIN TABLE TERMINATED THEN
TINYBLOB TINYINT TINYTEXT TO TRAILING TRIGGER TRUE UNDO UNION
UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE UTC_TIME
UTC_TIMESTAMP VALUES VARBINARY VARCHAR VARCHARACTER VARYING WHEN
WHERE WHILE WITH WRITE XOR YEAR_MONTH ZEROFILL))
"List of all of MySQL's reserved words.
http://dev.mysql.com/doc/refman/5.5/en/reserved-words.html")
(defclass emacsql-mysql-connection (emacsql-connection)
((dbname :reader emacsql-psql-dbname :initarg :dbname)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE")
(object "LONGTEXT")
(nil "LONGTEXT"))))
"A connection to a MySQL database.")
(cl-defun emacsql-mysql (database &key user password host port debug)
"Connect to a MySQL server using the mysql command line program."
(let* ((mysql (or (executable-find emacsql-mysql-executable)
(error "No mysql binary available, aborting")))
(command (list database "--skip-pager" "-rfBNL" mysql)))
(when user (push (format "--user=%s" user) command))
(when password (push (format "--password=%s" password) command))
(when host (push (format "--host=%s" host) command))
(when port (push (format "--port=%s" port) command))
(let* ((process-connection-type t)
(buffer (generate-new-buffer " *emacsql-mysql*"))
(command (mapconcat #'shell-quote-argument (nreverse command) " "))
(process (start-process-shell-command
"emacsql-mysql" buffer (concat "stty raw &&" command)))
(connection (make-instance 'emacsql-mysql-connection
:handle process
:dbname database)))
(set-process-sentinel process
(lambda (proc _) (kill-buffer (process-buffer proc))))
(set-process-query-on-exit-flag (oref connection handle) nil)
(when debug (emacsql-enable-debugging connection))
(emacsql connection
[:set-session (= sql-mode 'NO_BACKSLASH_ESCAPES\,ANSI_QUOTES)])
(emacsql connection
[:set-transaction-isolation-level :serializable])
(emacsql-register connection))))
(cl-defmethod emacsql-close ((connection emacsql-mysql-connection))
(let ((process (oref connection handle)))
(when (process-live-p process)
(process-send-eof process))))
(cl-defmethod emacsql-send-message ((connection emacsql-mysql-connection) message)
(let ((process (oref connection handle)))
(process-send-string process message)
(process-send-string process "\\c\\p\n")))
(cl-defmethod emacsql-waiting-p ((connection emacsql-mysql-connection))
(let ((length (length emacsql-mysql-sentinel)))
(with-current-buffer (emacsql-buffer connection)
(and (>= (buffer-size) length)
(progn (goto-char (- (point-max) length))
(looking-at emacsql-mysql-sentinel))))))
(cl-defmethod emacsql-parse ((connection emacsql-mysql-connection))
(with-current-buffer (emacsql-buffer connection)
(let ((standard-input (current-buffer)))
(goto-char (point-min))
(when (looking-at "ERROR")
(search-forward ": ")
(signal 'emacsql-error
(list (buffer-substring (point) (line-end-position)))))
(cl-loop until (looking-at emacsql-mysql-sentinel)
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (setq row ())
and do (forward-char)
finally (cl-return rows)))))
(provide 'emacsql-mysql)
;;; emacsql-mysql.el ends here

Binary file not shown.

View File

@@ -0,0 +1,80 @@
;;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for PostgreSQL, which
;; uses the `pg' package to directly speak to the database. This
;; library requires at least Emacs 28.1.
;; (For an alternative back-end for PostgreSQL, see `emacsql-psql'.)
;;; Code:
(require 'emacsql)
(if (>= emacs-major-version 28)
(require 'pg nil t)
(message "emacsql-pg.el requires Emacs 28.1 or later"))
(declare-function pg-connect "ext:pg"
( dbname user &optional
(password "") (host "localhost") (port 5432) (tls nil)))
(declare-function pg-disconnect "ext:pg" (con))
(declare-function pg-exec "ext:pg" (connection &rest args))
(declare-function pg-result "ext:pg" (result what &rest arg))
(defclass emacsql-pg-connection (emacsql-connection)
((pgcon :reader emacsql-pg-pgcon :initarg :pgcon)
(dbname :reader emacsql-pg-dbname :initarg :dbname)
(result :accessor emacsql-pg-result)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE PRECISION")
(object "TEXT")
(nil "TEXT"))))
"A connection to a PostgreSQL database via pg.el.")
(cl-defun emacsql-pg (dbname user &key
(host "localhost") (password "") (port 5432) debug)
"Connect to a PostgreSQL server using pg.el."
(require 'pg)
(let* ((pgcon (pg-connect dbname user password host port))
(connection (make-instance 'emacsql-pg-connection
:handle (and (fboundp 'pgcon-process)
(pgcon-process pgcon))
:pgcon pgcon
:dbname dbname)))
(when debug (emacsql-enable-debugging connection))
(emacsql connection [:set (= default-transaction-isolation 'SERIALIZABLE)])
(emacsql-register connection)))
(cl-defmethod emacsql-close ((connection emacsql-pg-connection))
(ignore-errors (pg-disconnect (emacsql-pg-pgcon connection))))
(cl-defmethod emacsql-send-message ((connection emacsql-pg-connection) message)
(condition-case error
(setf (emacsql-pg-result connection)
(pg-exec (emacsql-pg-pgcon connection) message))
(error (signal 'emacsql-error error))))
(cl-defmethod emacsql-waiting-p ((_connection emacsql-pg-connection))
;; pg-exec will block
t)
(cl-defmethod emacsql-parse ((connection emacsql-pg-connection))
(let ((tuples (pg-result (emacsql-pg-result connection) :tuples)))
(cl-loop for tuple in tuples collect
(cl-loop for value in tuple
when (stringp value) collect (read value)
else collect value))))
(provide 'emacsql-pg)
;;; emacsql-pg.el ends here

Binary file not shown.

View File

@@ -0,0 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "emacsql" "20251130.1841"
"High-level SQL database front-end."
'((emacs "26.1"))
:url "https://github.com/magit/emacsql"
:commit "f177a41e93b92a4b1139a553eed5415ca33f439c"
:revdesc "f177a41e93b9"
:authors '(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainers '(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")))

View File

@@ -0,0 +1,145 @@
;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for PostgreSQL, which
;; uses the standard `psql' command line program.
;; (For an alternative back-end for PostgreSQL, see `emacsql-pg'.)
;;; Code:
(require 'emacsql)
(defvar emacsql-psql-executable "psql"
"Path to the psql (PostgreSQL client) executable.")
(defun emacsql-psql-unavailable-p ()
"Return a reason if the psql executable is not available.
:no-executable -- cannot find the executable
:cannot-execute -- cannot run the executable
:old-version -- sqlite3 version is too old"
(let ((psql emacsql-psql-executable))
(if (null (executable-find psql))
:no-executable
(condition-case _
(with-temp-buffer
(call-process psql nil (current-buffer) nil "--version")
(let ((version (cl-third (split-string (buffer-string)))))
(if (version< version "1.0.0")
:old-version
nil)))
(error :cannot-execute)))))
(defconst emacsql-psql-reserved
(emacsql-register-reserved
'( ALL ANALYSE ANALYZE AND ANY AS ASC AUTHORIZATION BETWEEN BINARY
BOTH CASE CAST CHECK COLLATE COLUMN CONSTRAINT CREATE CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER DEFAULT
DEFERRABLE DESC DISTINCT DO ELSE END EXCEPT FALSE FOR FOREIGN
FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN INITIALLY INNER
INTERSECT INTO IS ISNULL JOIN LEADING LEFT LIKE LIMIT LOCALTIME
LOCALTIMESTAMP NATURAL NEW NOT NOTNULL NULL OFF OFFSET OLD ON
ONLY OR ORDER OUTER OVERLAPS PLACING PRIMARY REFERENCES RIGHT
SELECT SESSION_USER SIMILAR SOME TABLE THEN TO TRAILING TRUE
UNION UNIQUE USER USING VERBOSE WHEN WHERE))
"List of all of PostgreSQL's reserved words.
http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
(defclass emacsql-psql-connection (emacsql-connection)
((dbname :reader emacsql-psql-dbname :initarg :dbname)
(types :allocation :class
:reader emacsql-types
:initform '((integer "BIGINT")
(float "DOUBLE PRECISION")
(object "TEXT")
(nil "TEXT"))))
"A connection to a PostgreSQL database via psql.")
(cl-defun emacsql-psql (dbname &key username hostname port debug)
"Connect to a PostgreSQL server using the psql command line program."
(let ((args (list dbname)))
(when username
(push username args))
(push "-n" args)
(when port
(push "-p" args)
(push port args))
(when hostname
(push "-h" args)
(push hostname args))
(setq args (nreverse args))
(let* ((buffer (generate-new-buffer " *emacsql-psql*"))
(psql emacsql-psql-executable)
(command (mapconcat #'shell-quote-argument (cons psql args) " "))
(process (start-process-shell-command
"emacsql-psql" buffer (concat "stty raw && " command)))
(connection (make-instance 'emacsql-psql-connection
:handle process
:dbname dbname)))
(setf (process-sentinel process)
(lambda (proc _) (kill-buffer (process-buffer proc))))
(set-process-query-on-exit-flag (oref connection handle) nil)
(when debug (emacsql-enable-debugging connection))
(mapc (apply-partially #'emacsql-send-message connection)
'("\\pset pager off"
"\\pset null nil"
"\\a"
"\\t"
"\\f ' '"
"SET client_min_messages TO ERROR;"
"\\set PROMPT1 ]"
"EMACSQL;")) ; error message flush
(emacsql-wait connection)
(emacsql connection
[:set (= default-transaction-isolation 'SERIALIZABLE)])
(emacsql-register connection))))
(cl-defmethod emacsql-close ((connection emacsql-psql-connection))
(let ((process (oref connection handle)))
(when (process-live-p process)
(process-send-string process "\\q\n"))))
(cl-defmethod emacsql-send-message ((connection emacsql-psql-connection) message)
(let ((process (oref connection handle)))
(process-send-string process message)
(process-send-string process "\n")))
(cl-defmethod emacsql-waiting-p ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(cond ((= (buffer-size) 1) (string= "]" (buffer-string)))
((> (buffer-size) 1) (string= "\n]" (buffer-substring
(- (point-max) 2)
(point-max)))))))
(cl-defmethod emacsql-check-error ((connection emacsql-psql-connection))
(with-current-buffer (emacsql-buffer connection)
(let ((case-fold-search t))
(goto-char (point-min))
(when (looking-at "error:")
(let* ((beg (line-beginning-position))
(end (line-end-position)))
(signal 'emacsql-error (list (buffer-substring beg end))))))))
(cl-defmethod emacsql-parse ((connection emacsql-psql-connection))
(emacsql-check-error connection)
(with-current-buffer (emacsql-buffer connection)
(let ((standard-input (current-buffer)))
(goto-char (point-min))
(cl-loop until (looking-at "]")
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (progn (forward-char 1) (setq row ()))
finally (cl-return rows)))))
(provide 'emacsql-psql)
;;; emacsql-psql.el ends here

Binary file not shown.

View File

@@ -0,0 +1,87 @@
;;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for SQLite, which uses
;; the built-in SQLite support in Emacs 29 an later.
;;; Code:
(require 'emacsql-sqlite)
(declare-function sqlite-open "sqlite.c")
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-close "sqlite.c")
(emacsql-register-reserved emacsql-sqlite-reserved)
(defclass emacsql-sqlite-builtin-connection (emacsql--sqlite-base) ()
"A connection to a SQLite database using builtin support.")
(cl-defmethod initialize-instance :after
((connection emacsql-sqlite-builtin-connection) &rest _)
(oset connection handle
(sqlite-open (oref connection file)))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
(cl-defun emacsql-sqlite-builtin (file &key debug)
"Open a connected to database stored in FILE.
If FILE is nil use an in-memory database.
:debug LOG -- When non-nil, log all SQLite commands to a log
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-builtin-connection
:file file)))
(when debug
(emacsql-enable-debugging connection))
connection))
(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-builtin-connection))
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))
(when (oref connection handle)
(sqlite-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-builtin-connection) message)
(condition-case err
(let ((headerp emacsql-include-header))
(mapcar (lambda (row)
(cond
(headerp (setq headerp nil) row)
((mapcan (lambda (col)
(cond ((null col) (list nil))
((equal col "") (list ""))
((numberp col) (list col))
((emacsql-sqlite-read-column col))))
row))))
(sqlite-select (oref connection handle) message nil
(and emacsql-include-header 'full))))
((sqlite-error sqlite-locked-error)
(if (stringp (cdr err))
(signal 'emacsql-error (list (cdr err)))
(pcase-let* ((`(,_ ,errstr ,errmsg ,errcode ,ext-errcode) err)
(`(,_ ,_ ,signal ,_)
(assq errcode emacsql-sqlite-error-codes)))
(signal (or signal 'emacsql-error)
(list errmsg errcode ext-errcode errstr)))))
(error
(signal 'emacsql-error (cdr err)))))
(cl-defmethod emacsql ((connection emacsql-sqlite-builtin-connection) sql &rest args)
(emacsql-send-message connection (apply #'emacsql-compile connection sql args)))
(provide 'emacsql-sqlite-builtin)
;;; emacsql-sqlite-builtin.el ends here

View File

@@ -0,0 +1,97 @@
;;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides an EmacSQL back-end for SQLite, which uses
;; the Emacs module provided by the `sqlite3' package.
;;; Code:
(require 'emacsql-sqlite)
(require 'sqlite3 nil t)
;; Prevent check-declare from finding the defining file but then making
;; noise because it fails to find the definition because it is a module.
(declare-function sqlite3-open "ext:module:sqlite3-api")
(declare-function sqlite3-exec "ext:module:sqlite3-api")
(declare-function sqlite3-close "ext:module:sqlite3-api")
(defvar sqlite-open-readwrite)
(defvar sqlite-open-create)
(emacsql-register-reserved emacsql-sqlite-reserved)
(defclass emacsql-sqlite-module-connection (emacsql--sqlite-base) ()
"A connection to a SQLite database using a module.")
(cl-defmethod initialize-instance :after
((connection emacsql-sqlite-module-connection) &rest _)
(require (quote sqlite3))
(oset connection handle
(sqlite3-open (or (oref connection file) ":memory:")
sqlite-open-readwrite
sqlite-open-create))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
(cl-defun emacsql-sqlite-module (file &key debug)
"Open a connected to database stored in FILE.
If FILE is nil use an in-memory database.
:debug LOG -- When non-nil, log all SQLite commands to a log
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-module-connection
:file file)))
(when debug
(emacsql-enable-debugging connection))
connection))
(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-module-connection))
(and (oref connection handle) t))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))
(when (oref connection handle)
(sqlite3-close (oref connection handle))
(oset connection handle nil)))
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-module-connection) message)
(condition-case err
(let ((include-header emacsql-include-header)
(rows ()))
(sqlite3-exec (oref connection handle)
message
(lambda (_ row header)
(when include-header
(push header rows)
(setq include-header nil))
(push (mapcan (lambda (col)
(cond
((null col) (list nil))
((equal col "") (list ""))
((emacsql-sqlite-read-column col))))
row)
rows)))
(nreverse rows))
((db-error sql-error)
(pcase-let* ((`(,_ ,errmsg ,errcode) err)
(`(,_ ,_ ,signal ,errstr)
(assq errcode emacsql-sqlite-error-codes)))
(signal (or signal 'emacsql-error)
(list errmsg errcode nil errstr))))
(error
(signal 'emacsql-error (cdr err)))))
(cl-defmethod emacsql ((connection emacsql-sqlite-module-connection) sql &rest args)
(emacsql-send-message connection (apply #'emacsql-compile connection sql args)))
(provide 'emacsql-sqlite-module)
;;; emacsql-sqlite-module.el ends here

View File

@@ -0,0 +1,296 @@
;;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library contains code that is used by both SQLite back-ends.
;;; Code:
(require 'emacsql)
;;; Base class
(defclass emacsql--sqlite-base (emacsql-connection)
((file :initarg :file
:initform nil
:type (or null string)
:documentation "Database file name.")
(types :allocation :class
:reader emacsql-types
:initform '((integer "INTEGER")
(float "REAL")
(object "TEXT")
(nil nil))))
:abstract t)
;;; Constants
(defconst emacsql-sqlite-reserved
'( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH
AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK
COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS
CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT
DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END
ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL
GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY
INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE
LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER
OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP
REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW
SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION
TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN
WHERE WITH WITHOUT)
"List of all of SQLite's reserved words.
Also see http://www.sqlite.org/lang_keywords.html.")
(defconst emacsql-sqlite-error-codes
'((1 SQLITE_ERROR emacsql-error "SQL logic error")
(2 SQLITE_INTERNAL emacsql-internal nil)
(3 SQLITE_PERM emacsql-access "access permission denied")
(4 SQLITE_ABORT emacsql-error "query aborted")
(5 SQLITE_BUSY emacsql-locked "database is locked")
(6 SQLITE_LOCKED emacsql-locked "database table is locked")
(7 SQLITE_NOMEM emacsql-memory "out of memory")
(8 SQLITE_READONLY emacsql-access "attempt to write a readonly database")
(9 SQLITE_INTERRUPT emacsql-error "interrupted")
(10 SQLITE_IOERR emacsql-access "disk I/O error")
(11 SQLITE_CORRUPT emacsql-corruption "database disk image is malformed")
(12 SQLITE_NOTFOUND emacsql-error "unknown operation")
(13 SQLITE_FULL emacsql-access "database or disk is full")
(14 SQLITE_CANTOPEN emacsql-access "unable to open database file")
(15 SQLITE_PROTOCOL emacsql-access "locking protocol")
(16 SQLITE_EMPTY emacsql-corruption nil)
(17 SQLITE_SCHEMA emacsql-error "database schema has changed")
(18 SQLITE_TOOBIG emacsql-error "string or blob too big")
(19 SQLITE_CONSTRAINT emacsql-constraint "constraint failed")
(20 SQLITE_MISMATCH emacsql-error "datatype mismatch")
(21 SQLITE_MISUSE emacsql-error "bad parameter or other API misuse")
(22 SQLITE_NOLFS emacsql-error "large file support is disabled")
(23 SQLITE_AUTH emacsql-access "authorization denied")
(24 SQLITE_FORMAT emacsql-corruption nil)
(25 SQLITE_RANGE emacsql-error "column index out of range")
(26 SQLITE_NOTADB emacsql-corruption "file is not a database")
(27 SQLITE_NOTICE emacsql-warning "notification message")
(28 SQLITE_WARNING emacsql-warning "warning message"))
"Alist mapping SQLite error codes to EmacSQL conditions.
Elements have the form (ERRCODE SYMBOLIC-NAME EMACSQL-ERROR
ERRSTR). Also see https://www.sqlite.org/rescode.html.")
;;; Variables
(defvar emacsql-include-header nil
"Whether to include names of columns as an additional row.
Never enable this globally, only let-bind it around calls to `emacsql'.
Currently only supported by `emacsql-sqlite-builtin-connection' and
`emacsql-sqlite-module-connection'.")
(defvar emacsql-sqlite-busy-timeout 20
"Seconds to wait when trying to access a table blocked by another process.
See https://www.sqlite.org/c3ref/busy_timeout.html.")
;;; Utilities
(defun emacsql-sqlite-connection (variable file &optional setup use-module)
"Return the connection stored in VARIABLE to the database in FILE.
If the value of VARIABLE is a live database connection, return that.
Otherwise open a new connection to the database in FILE and store the
connection in VARIABLE, before returning it. If FILE is nil, use an
in-memory database. Always enable support for foreign key constrains.
If optional SETUP is non-nil, it must be a function, which takes the
connection as only argument. This function can be used to initialize
tables, for example.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(or (let ((connection (symbol-value variable)))
(and connection (emacsql-live-p connection) connection))
(set variable (emacsql-sqlite-open file nil setup use-module))))
(defun emacsql-sqlite-open (file &optional debug setup use-module)
"Open a connection to the database stored in FILE using an SQLite back-end.
Automatically use the best available back-end, as returned by
`emacsql-sqlite-default-connection'.
If FILE is nil, use an in-memory database. If optional DEBUG is
non-nil, log all SQLite commands to a log buffer, for debugging
purposes. Always enable support for foreign key constrains.
If optional SETUP is non-nil, it must be a function, which takes the
connection as only argument. This function can be used to initialize
tables, for example.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(when file
(make-directory (file-name-directory file) t))
(let* ((class (emacsql-sqlite-default-connection use-module))
(connection (make-instance class :file file)))
(when debug
(emacsql-enable-debugging connection))
(emacsql connection [:pragma (= foreign-keys on)])
(when setup
(funcall setup connection))
connection))
(defun emacsql-sqlite-default-connection (&optional use-module)
"Determine and return the best SQLite connection class.
Signal an error if none of the connection classes can be used.
If optional USE-MODULE is non-nil, then use the external module even
when Emacs was built with SQLite support. This is intended for testing
purposes."
(or (and (not use-module)
(fboundp 'sqlite-available-p)
(sqlite-available-p)
(require 'emacsql-sqlite-builtin)
'emacsql-sqlite-builtin-connection)
(and (boundp 'module-file-suffix)
module-file-suffix
(condition-case nil
;; Failure modes:
;; 1. `libsqlite' shared library isn't available.
;; 2. User chooses to not compile `libsqlite'.
;; 3. `libsqlite' compilation fails.
(and (require 'sqlite3)
(require 'emacsql-sqlite-module)
'emacsql-sqlite-module-connection)
(error
(display-warning 'emacsql "\
Since your Emacs does not come with
built-in SQLite support [1], but does support C modules, we can
use an EmacSQL backend that relies on the third-party `sqlite3'
package [2].
Please install the `sqlite3' Elisp package using your preferred
Emacs package manager, and install the SQLite shared library
using your distribution's package manager. That package should
be named something like `libsqlite3' [3] and NOT just `sqlite3'.
The legacy backend, which uses a custom SQLite executable, has
been remove, so we can no longer fall back to that.
[1]: Supported since Emacs 29.1, provided it was not disabled
with `--without-sqlite3'.
[2]: https://github.com/pekingduck/emacs-sqlite3-api
[3]: On Debian https://packages.debian.org/buster/libsqlite3-0")
;; The buffer displaying the warning might immediately
;; be replaced by another buffer, before the user gets
;; a chance to see it. We cannot have that.
(let (fn)
(setq fn (lambda ()
(remove-hook 'post-command-hook fn)
(pop-to-buffer (get-buffer "*Warnings*"))))
(add-hook 'post-command-hook fn))
nil)))
(error "EmacSQL could not find or compile a back-end")))
(defun emacsql-sqlite-set-busy-timeout (connection)
(when emacsql-sqlite-busy-timeout
(emacsql connection [:pragma (= busy-timeout $s1)]
(* emacsql-sqlite-busy-timeout 1000))))
(defun emacsql-sqlite-read-column (string)
(let ((value nil)
(beg 0)
(end (length string)))
(while (< beg end)
(let ((v (read-from-string string beg)))
(push (car v) value)
(setq beg (cdr v))))
(nreverse value)))
(defun emacsql-sqlite-list-tables (connection)
"Return a list of symbols identifying tables in CONNECTION.
Tables whose names begin with \"sqlite_\", are not included
in the returned value."
(mapcar #'car
(emacsql connection
[:select name
;; The new name is `sqlite-schema', but this name
;; is supported by old and new SQLite versions.
;; See https://www.sqlite.org/schematab.html.
:from sqlite-master
:where (and (= type 'table)
(not-like name "sqlite_%"))
:order-by [(asc name)]])))
(defun emacsql-sqlite-dump-database (connection &optional versionp)
"Dump the database specified by CONNECTION to a file.
The dump file is placed in the same directory as the database
file and its name derives from the name of the database file.
The suffix is replaced with \".sql\" and if optional VERSIONP is
non-nil, then the database version (the `user_version' pragma)
and a timestamp are appended to the file name.
Dumping is done using the official `sqlite3' binary. If that is
not available and VERSIONP is non-nil, then the database file is
copied instead."
(let* ((version (caar (emacsql connection [:pragma user-version])))
(db (oref connection file))
(db (if (symbolp db) (symbol-value db) db))
(name (file-name-nondirectory db))
(output (concat (file-name-sans-extension db)
(and versionp
(concat (format "-v%s" version)
(format-time-string "-%Y%m%d-%H%M")))
".sql")))
(cond
((locate-file "sqlite3" exec-path)
(when (and (file-exists-p output) versionp)
(error "Cannot dump database; %s already exists" output))
(with-temp-file output
(message "Dumping %s database to %s..." name output)
(unless (zerop (save-excursion
(call-process "sqlite3" nil t nil db ".dump")))
(error "Failed to dump %s" db))
(when version
(insert (format "PRAGMA user_version=%s;\n" version)))
;; The output contains "PRAGMA foreign_keys=OFF;".
;; Change that to avoid alarming attentive users.
(when (re-search-forward "^PRAGMA foreign_keys=\\(OFF\\);" 1000 t)
(replace-match "ON" t t nil 1))
(message "Dumping %s database to %s...done" name output)))
(versionp
(setq output (concat (file-name-sans-extension output) ".db"))
(message "Cannot dump database because sqlite3 binary cannot be found")
(when (and (file-exists-p output) versionp)
(error "Cannot copy database; %s already exists" output))
(message "Copying %s database to %s..." name output)
(copy-file db output)
(message "Copying %s database to %s...done" name output))
((error "Cannot dump database; sqlite3 binary isn't available")))))
(defun emacsql-sqlite-restore-database (db dump)
"Restore database DB from DUMP.
DUMP is a file containing SQL statements. DB can be the file
in which the database is to be stored, or it can be a database
connection. In the latter case the current database is first
dumped to a new file and the connection is closed. Then the
database is restored from DUMP. No connection to the new
database is created."
(unless (stringp db)
(emacsql-sqlite-dump-database db t)
(emacsql-close (prog1 db (setq db (oref db file)))))
(with-temp-buffer
(unless (zerop (call-process "sqlite3" nil t nil db
(format ".read %s" dump)))
(error "Failed to read %s: %s" dump (buffer-string)))))
(provide 'emacsql-sqlite)
;;; emacsql-sqlite.el ends here

Binary file not shown.

View File

@@ -0,0 +1,384 @@
;;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 20251130.1841
;; Package-Revision: f177a41e93b9
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; EmacSQL is a high-level Emacs Lisp front-end for SQLite.
;; PostgreSQL and MySQL are also supported, but use of these connectors
;; is not recommended.
;; Any readable lisp value can be stored as a value in EmacSQL,
;; including numbers, strings, symbols, lists, vectors, and closures.
;; EmacSQL has no concept of TEXT values; it's all just lisp objects.
;; The lisp object `nil' corresponds 1:1 with NULL in the database.
;; See README.md for much more complete documentation.
;;; Code:
(require 'cl-lib)
(require 'cl-generic)
(require 'eieio)
(require 'emacsql-compiler)
(defgroup emacsql nil
"The EmacSQL SQL database front-end."
:group 'comm)
(defconst emacsql-version "4.3.3")
(defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command.
If nil, wait forever. This is used by the `mysql', `pg' and `psql'. It
is not being used by the `sqlite-builtin' and `sqlite-module' back-ends,
which respect `emacsql-sqlite-busy-timeout' instead.")
;;; Database connection
(defclass emacsql-connection ()
((handle :initarg :handle
:documentation "Internal connection handler.
The value is a record-like object and should not be accessed
directly. Depending on the concrete implementation, `type-of'
may return `process', `user-ptr' or `sqlite' for this value.")
(log-buffer :type (or null buffer)
:initarg :log-buffer
:initform nil
:documentation "Output log (debug).")
(finalizer :documentation "Object returned from `make-finalizer'.")
(types :allocation :class
:initform nil
:reader emacsql-types
:documentation "Maps EmacSQL types to SQL types."))
"A connection to a SQL database."
:abstract t)
(cl-defgeneric emacsql-close (connection)
"Close CONNECTION and free all resources.")
(cl-defgeneric emacsql-reconnect (connection)
"Re-establish CONNECTION with the same parameters.")
(cl-defmethod emacsql-live-p ((connection emacsql-connection))
"Return non-nil if CONNECTION is still alive and ready."
(and (process-live-p (oref connection handle)) t))
(cl-defgeneric emacsql-types (connection)
"Return an alist mapping EmacSQL types to database types.
This will mask `emacsql-type-map' during expression compilation.
This alist should have four key symbols: integer, float, object,
nil (default type). The values are strings to be inserted into
a SQL expression.")
(cl-defmethod emacsql-buffer ((connection emacsql-connection))
"Get process buffer for CONNECTION."
(process-buffer (oref connection handle)))
(cl-defmethod emacsql-enable-debugging ((connection emacsql-connection))
"Enable debugging on CONNECTION."
(unless (buffer-live-p (oref connection log-buffer))
(oset connection log-buffer (generate-new-buffer " *emacsql-log*"))))
(cl-defmethod emacsql-log ((connection emacsql-connection) message)
"Log MESSAGE into CONNECTION's log.
MESSAGE should not have a newline on the end."
(let ((buffer (oref connection log-buffer)))
(when buffer
(unless (buffer-live-p buffer)
(setq buffer (emacsql-enable-debugging connection)))
(with-current-buffer buffer
(goto-char (point-max))
(princ (concat message "\n") buffer)))))
;;; Sending and receiving
(cl-defgeneric emacsql-send-message (connection message)
"Send MESSAGE to CONNECTION.")
(cl-defmethod emacsql-send-message :before
((connection emacsql-connection) message)
(emacsql-log connection message))
(cl-defmethod emacsql-clear ((connection emacsql-connection))
"Clear the connection buffer for CONNECTION-SPEC."
(let ((buffer (emacsql-buffer connection)))
(when (and buffer (buffer-live-p buffer))
(with-current-buffer buffer
(erase-buffer)))))
(cl-defgeneric emacsql-waiting-p (connection)
"Return non-nil if CONNECTION is ready for more input.")
(cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout)
"Block until CONNECTION is waiting for further input."
(let* ((real-timeout (or timeout emacsql-global-timeout))
(end (and real-timeout (+ (float-time) real-timeout))))
(while (and (or (null real-timeout) (< (float-time) end))
(not (emacsql-waiting-p connection)))
(save-match-data
(accept-process-output (oref connection handle) real-timeout)))
(unless (emacsql-waiting-p connection)
(signal 'emacsql-timeout (list "Query timed out" real-timeout)))))
(cl-defgeneric emacsql-parse (connection)
"Return the results of parsing the latest output or signal an error.")
(defun emacsql-compile (connection sql &rest args)
"Compile s-expression SQL for CONNECTION into a string."
(let ((emacsql-type-map (or (and connection (emacsql-types connection))
emacsql-type-map)))
(concat (apply #'emacsql-format (emacsql-prepare sql) args) ";")))
(cl-defgeneric emacsql (connection sql &rest args)
"Send SQL s-expression to CONNECTION and return the results.")
(cl-defmethod emacsql ((connection emacsql-connection) sql &rest args)
(let ((sql-string (apply #'emacsql-compile connection sql args)))
(emacsql-clear connection)
(emacsql-send-message connection sql-string)
(emacsql-wait connection)
(emacsql-parse connection)))
;;; Helper mixin class
(defclass emacsql-protocol-mixin () ()
"A mixin for back-ends following the EmacSQL protocol.
The back-end prompt must be a single \"]\" character. This prompt
value was chosen because it is unreadable. Output must have
exactly one row per line, fields separated by whitespace. NULL
must display as \"nil\"."
:abstract t)
(cl-defmethod emacsql-waiting-p ((connection emacsql-protocol-mixin))
"Return t if the end of the buffer has a properly-formatted prompt.
Also return t if the connection buffer has been killed."
(let ((buffer (emacsql-buffer connection)))
(or (not (buffer-live-p buffer))
(with-current-buffer buffer
(and (>= (buffer-size) 2)
(string= "#\n"
(buffer-substring (- (point-max) 2) (point-max))))))))
(cl-defmethod emacsql-handle ((_ emacsql-protocol-mixin) code message)
"Signal a specific condition for CODE from CONNECTION.
Subclasses should override this method in order to provide more
specific error conditions."
(signal 'emacsql-error (list message code)))
(cl-defmethod emacsql-parse ((connection emacsql-protocol-mixin))
"Parse well-formed output into an s-expression."
(with-current-buffer (emacsql-buffer connection)
(goto-char (point-min))
(let* ((standard-input (current-buffer))
(value (read)))
(if (eq value 'error)
(emacsql-handle connection (read) (read))
(prog1 value
(unless (eq (read) 'success)
(emacsql-handle connection (read) (read))))))))
;;; Automatic connection cleanup
(defun emacsql-register (connection)
"Register CONNECTION for automatic cleanup and return CONNECTION."
(prog1 connection
(oset connection finalizer
(make-finalizer (lambda () (emacsql-close connection))))))
;;; Useful macros
(defmacro emacsql-with-connection (connection-spec &rest body)
"Open an EmacSQL connection, evaluate BODY, and close the connection.
CONNECTION-SPEC establishes a single binding.
(emacsql-with-connection (db (emacsql-sqlite \"company.db\"))
(emacsql db [:create-table foo [x]])
(emacsql db [:insert :into foo :values ([1] [2] [3])])
(emacsql db [:select * :from foo]))"
(declare (indent 1))
`(let ((,(car connection-spec) ,(cadr connection-spec)))
(unwind-protect
(progn ,@body)
(emacsql-close ,(car connection-spec)))))
(defvar emacsql--transaction-level 0
"Keeps track of nested transactions in `emacsql-with-transaction'.")
(defmacro emacsql-with-transaction (connection &rest body)
"Evaluate BODY inside a single transaction, issuing a rollback on error.
This macro can be nested indefinitely, wrapping everything in a
single transaction at the lowest level.
Warning: BODY should *not* have any side effects besides making
changes to the database behind CONNECTION. Body may be evaluated
multiple times before the changes are committed."
(declare (indent 1))
`(let ((emacsql--connection ,connection)
(emacsql--completed nil)
(emacsql--transaction-level (1+ emacsql--transaction-level))
(emacsql--result))
(unwind-protect
(while (not emacsql--completed)
(condition-case nil
(progn
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:begin]))
(let ((result (progn ,@body)))
(setq emacsql--result result)
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:commit]))
(setq emacsql--completed t)))
(emacsql-locked (emacsql emacsql--connection [:rollback])
(sleep-for 0.05))))
(when (and (= 1 emacsql--transaction-level)
(not emacsql--completed))
(emacsql emacsql--connection [:rollback])))
emacsql--result))
(defmacro emacsql-thread (connection &rest statements)
"Thread CONNECTION through STATEMENTS.
A statement can be a list, containing a statement with its arguments."
(declare (indent 1))
`(let ((emacsql--conn ,connection))
(emacsql-with-transaction emacsql--conn
,@(cl-loop for statement in statements
when (vectorp statement)
collect (list 'emacsql 'emacsql--conn statement)
else
collect (append (list 'emacsql 'emacsql--conn) statement)))))
(defmacro emacsql-with-bind (connection sql-and-args &rest body)
"For each result row bind the column names for each returned row.
Returns the result of the last evaluated BODY.
All column names must be provided in the query ($ and * are not
allowed). Hint: all of the bound identifiers must be known at
compile time. For example, in the expression below the variables
`name' and `phone' will be bound for the body.
(emacsql-with-bind db [:select [name phone] :from people]
(message \"Found %s with %s\" name phone))
(emacsql-with-bind db ([:select [name phone]
:from people
:where (= name $1)] my-name)
(message \"Found %s with %s\" name phone))
Each column must be a plain symbol, no expressions allowed here."
(declare (indent 2))
(let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args)))
(args (and (not (vectorp sql-and-args)) (cdr sql-and-args))))
(cl-assert (eq :select (elt sql 0)))
(let ((vars (elt sql 1)))
(when (eq vars '*)
(error "Must explicitly list columns in `emacsql-with-bind'"))
(cl-assert (cl-every #'symbolp vars))
`(let ((emacsql--results (emacsql ,connection ,sql ,@args))
(emacsql--final nil))
(dolist (emacsql--result emacsql--results emacsql--final)
(setq emacsql--final
(cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result
,@body)))))))
;;; User interaction functions
(defvar emacsql-show-buffer-name "*emacsql-show*"
"Name of the buffer for displaying intermediate SQL.")
(defun emacsql--indent ()
"Indent and wrap the SQL expression in the current buffer."
(save-excursion
(goto-char (point-min))
(let ((case-fold-search nil))
(while (search-forward-regexp " [A-Z]+" nil :no-error)
(when (> (current-column) (* fill-column 0.8))
(backward-word)
(insert "\n "))))))
(defun emacsql-show-sql (string)
"Fontify and display the SQL expression in STRING."
(let ((fontified
(with-temp-buffer
(insert string)
(sql-mode)
(with-no-warnings ;; autoloaded by previous line
(sql-highlight-sqlite-keywords))
(font-lock-ensure)
(emacsql--indent)
(buffer-string))))
(with-current-buffer (get-buffer-create emacsql-show-buffer-name)
(if (< (length string) fill-column)
(message "%s" fontified)
(let ((buffer-read-only nil))
(erase-buffer)
(insert fontified))
(special-mode)
(visual-line-mode)
(pop-to-buffer (current-buffer))))))
(defun emacsql-flatten-sql (sql)
"Convert a s-expression SQL into a flat string for display."
(cl-destructuring-bind (string . vars) (emacsql-prepare sql)
(concat
(apply #'format string (cl-loop for i in (mapcar #'car vars)
collect (intern (format "$%d" (1+ i)))))
";")))
;;;###autoload
(defun emacsql-show-last-sql (&optional prefix)
"Display the compiled SQL of the s-expression SQL expression before point.
A prefix argument causes the SQL to be printed into the current buffer."
(interactive "P")
(let ((sexp (if (fboundp 'elisp--preceding-sexp)
(elisp--preceding-sexp)
(with-no-warnings
(preceding-sexp)))))
(if (emacsql-sql-p sexp)
(let ((sql (emacsql-flatten-sql sexp)))
(if prefix
(insert sql)
(emacsql-show-sql sql)))
(user-error "Invalid SQL: %S" sexp))))
;;; Fix Emacs' broken vector indentation
(defun emacsql--inside-vector-p ()
"Return non-nil if point is inside a vector expression."
(let ((start (point)))
(save-excursion
(beginning-of-defun)
(let ((containing-sexp (elt (parse-partial-sexp (point) start) 1)))
(and containing-sexp
(progn (goto-char containing-sexp)
(looking-at "\\[")))))))
(defun emacsql--calculate-vector-indent (fn &optional parse-start)
"Don't indent vectors in `emacs-lisp-mode' like lists."
(if (save-excursion (beginning-of-line) (emacsql--inside-vector-p))
(let ((lisp-indent-offset 1))
(funcall fn parse-start))
(funcall fn parse-start)))
(defun emacsql-fix-vector-indentation ()
"When called, advise `calculate-lisp-indent' to stop indenting vectors.
Once activated, vector contents no longer indent like lists."
(interactive)
(advice-add 'calculate-lisp-indent :around
#'emacsql--calculate-vector-indent))
(provide 'emacsql)
;;; emacsql.el ends here

Binary file not shown.

View File

@@ -0,0 +1,6 @@
((nil
(indent-tabs-mode . nil))
(makefile-mode
(indent-tabs-mode . t))
(git-commit-mode
(git-commit-major-mode . git-commit-elisp-text-mode)))

View File

@@ -0,0 +1,112 @@
;;; llama-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from llama.el
(autoload 'llama "llama" "\
Expand to a `lambda' expression that wraps around FN and BODY.
This macro provides a compact way to write short `lambda' expressions.
It expands to a `lambda' expression, which calls the function FN with
arguments BODY and returns its value. The arguments of the `lambda'
expression are derived from symbols found in BODY.
Each symbol from `%1' through `%9', which appears in an unquoted part
of BODY, specifies a mandatory argument. Each symbol from `&1' through
`&9', which appears in an unquoted part of BODY, specifies an optional
argument. The symbol `&*' specifies extra (`&rest') arguments.
The shorter symbol `%' can be used instead of `%1', but using both in
the same expression is not allowed. Likewise `&' can be used instead
of `&1'. These shorthands are not recognized in function position.
To support binding forms that use a vector as VARLIST (such as `-let'
from the `dash' package), argument symbols are also detected inside of
vectors.
The space between `##' and FN can be omitted because `##' is read-syntax
for the symbol whose name is the empty string. If you prefer you can
place a space there anyway, and if you prefer to not use this somewhat
magical symbol at all, you can instead use the alternative name `llama'.
Instead of:
(lambda (a &optional _ c &rest d)
(foo a (bar c) d))
you can use this macro and write:
(##foo %1 (bar &3) &*)
which expands to:
(lambda (%1 &optional _&2 &3 &rest &*)
(foo %1 (bar &3) &*))
Unused trailing arguments and mandatory unused arguments at the border
between mandatory and optional arguments are also supported:
(##list %1 _%3 &5 _&6)
becomes:
(lambda (%1 _%2 _%3 &optional _&4 &5 _&6)
(list %1 &5))
Note how `_%3' and `_&6' are removed from the body, because their names
begin with an underscore. Also note that `_&4' is optional, unlike the
explicitly specified `_%3'.
Consider enabling `llama-fontify-mode' to highlight `##' and its
special arguments.
(fn FN &rest BODY)" nil t)
(defvar llama-fontify-mode nil "\
Non-nil if Llama-Fontify mode is enabled.
See the `llama-fontify-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `llama-fontify-mode'.")
(custom-autoload 'llama-fontify-mode "llama" nil)
(autoload 'llama-fontify-mode "llama" "\
In Emacs Lisp mode, highlight the `##' macro and its special arguments.
This is a global minor mode. If called interactively, toggle the
`Llama-Fontify mode' mode. If the prefix argument is positive, enable
the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the mode
if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='llama-fontify-mode)'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "llama" '("##" "all-completions" "elisp-" "intern" "lisp--el-match-keyword@llama" "llama-"))
;;; End of scraped data
(provide 'llama-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; llama-autoloads.el ends here

View File

@@ -0,0 +1,9 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "llama" "20251101.2002"
"Compact syntax for short lambda."
'((emacs "26.1")
(compat "30.1"))
:url "https://github.com/tarsius/llama"
:commit "e4803de8ab85991b6a944430bb4f543ea338636d"
:revdesc "e4803de8ab85"
:keywords '("extensions"))

View File

@@ -0,0 +1,572 @@
;;; llama.el --- Compact syntax for short lambda -*- lexical-binding:t -*-
;; Copyright (C) 2020-2025 Jonas Bernoulli
;; Authors: Jonas Bernoulli <emacs.llama@jonas.bernoulli.dev>
;; Homepage: https://github.com/tarsius/llama
;; Keywords: extensions
;; Package-Version: 20251101.2002
;; Package-Revision: e4803de8ab85
;; Package-Requires: (
;; (emacs "26.1")
;; (compat "30.1"))
;; SPDX-License-Identifier: GPL-3.0-or-later
;; This file 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 file 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 file. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package implements a macro named `##', which provides a compact way
;; to write short `lambda' expressions.
;; The signature of the macro is (## FN &rest BODY) and it expands to a
;; `lambda' expression, which calls the function FN with the arguments BODY
;; and returns the value of that. The arguments of the `lambda' expression
;; are derived from symbols found in BODY.
;; Each symbol from `%1' through `%9', which appears in an unquoted part
;; of BODY, specifies a mandatory argument. Each symbol from `&1' through
;; `&9', which appears in an unquoted part of BODY, specifies an optional
;; argument. The symbol `&*' specifies extra (`&rest') arguments.
;; The shorter symbol `%' can be used instead of `%1', but using both in
;; the same expression is not allowed. Likewise `&' can be used instead
;; of `&1'. These shorthands are not recognized in function position.
;; To support binding forms that use a vector as VARLIST (such as `-let'
;; from the `dash' package), argument symbols are also detected inside of
;; vectors.
;; The space between `##' and FN can be omitted because `##' is read-syntax
;; for the symbol whose name is the empty string. If you prefer you can
;; place a space there anyway, and if you prefer to not use this somewhat
;; magical symbol at all, you can instead use the alternative name `llama'.
;; Instead of:
;;
;; (lambda (a &optional _ c &rest d)
;; (foo a (bar c) d))
;;
;; you can use this macro and write:
;;
;; (##foo %1 (bar &3) &*)
;;
;; which expands to:
;;
;; (lambda (%1 &optional _&2 &3 &rest &*)
;; (foo %1 (bar &3) &*))
;; Unused trailing arguments and mandatory unused arguments at the border
;; between mandatory and optional arguments are also supported:
;;
;; (##list %1 _%3 &5 _&6)
;;
;; becomes:
;;
;; (lambda (%1 _%2 _%3 &optional _&4 &5 _&6)
;; (list %1 &5))
;;
;; Note how `_%3' and `_&6' are removed from the body, because their names
;; begin with an underscore. Also note that `_&4' is optional, unlike the
;; explicitly specified `_%3'.
;; Consider enabling `llama-fontify-mode' to highlight `##' and its
;; special arguments.
;;; Code:
(require 'compat)
;;;###autoload
(defmacro llama (fn &rest body)
"Expand to a `lambda' expression that wraps around FN and BODY.
This macro provides a compact way to write short `lambda' expressions.
It expands to a `lambda' expression, which calls the function FN with
arguments BODY and returns its value. The arguments of the `lambda'
expression are derived from symbols found in BODY.
Each symbol from `%1' through `%9', which appears in an unquoted part
of BODY, specifies a mandatory argument. Each symbol from `&1' through
`&9', which appears in an unquoted part of BODY, specifies an optional
argument. The symbol `&*' specifies extra (`&rest') arguments.
The shorter symbol `%' can be used instead of `%1', but using both in
the same expression is not allowed. Likewise `&' can be used instead
of `&1'. These shorthands are not recognized in function position.
To support binding forms that use a vector as VARLIST (such as `-let'
from the `dash' package), argument symbols are also detected inside of
vectors.
The space between `##' and FN can be omitted because `##' is read-syntax
for the symbol whose name is the empty string. If you prefer you can
place a space there anyway, and if you prefer to not use this somewhat
magical symbol at all, you can instead use the alternative name `llama'.
Instead of:
(lambda (a &optional _ c &rest d)
(foo a (bar c) d))
you can use this macro and write:
(##foo %1 (bar &3) &*)
which expands to:
(lambda (%1 &optional _&2 &3 &rest &*)
(foo %1 (bar &3) &*))
Unused trailing arguments and mandatory unused arguments at the border
between mandatory and optional arguments are also supported:
(##list %1 _%3 &5 _&6)
becomes:
(lambda (%1 _%2 _%3 &optional _&4 &5 _&6)
(list %1 &5))
Note how `_%3' and `_&6' are removed from the body, because their names
begin with an underscore. Also note that `_&4' is optional, unlike the
explicitly specified `_%3'.
Consider enabling `llama-fontify-mode' to highlight `##' and its
special arguments."
(cond ((symbolp fn))
((and (eq (car-safe fn) backquote-backquote-symbol)
(not body))
(setq body (cdr fn))
(setq fn backquote-backquote-symbol))
((signal 'wrong-type-argument
(list 'symbolp backquote-backquote-symbol fn))))
(let* ((args (make-vector 10 nil))
(body (cdr (llama--collect (cons fn body) args)))
(rest (aref args 0))
(args (nreverse (cdr (append args nil))))
(args (progn (while (and args (null (car args)))
(setq args (cdr args)))
args))
(pos (length args))
(opt nil)
(args (mapcar
(lambda (arg)
(if arg
(setq opt (string-match-p "\\`_?&" (symbol-name arg)))
(setq arg (intern (format "_%c%s" (if opt ?& ?%) pos))))
(setq pos (1- pos))
arg)
args))
(opt nil)
(args (mapcar
(lambda (symbol)
(cond
((string-match-p "\\`_?%" (symbol-name symbol))
(when opt
(error "`%s' cannot follow optional arguments" symbol))
(list symbol))
(opt
(list symbol))
((setq opt t)
(list '&optional symbol))))
(nreverse args))))
`(lambda
(,@(apply #'nconc args)
,@(and rest (list '&rest rest)))
(,fn ,@body))))
(defalias (intern "") 'llama)
(defalias '\#\# 'llama)
(defconst llama--unused-argument (make-symbol "llama--unused-argument"))
(defun llama--collect (expr args &optional fnpos backquoted unquote)
(cond
((memq (car-safe expr) (list (intern "") 'llama 'quote)) expr)
((and backquoted (symbolp expr)) expr)
((and backquoted
(memq (car-safe expr)
(list backquote-unquote-symbol
backquote-splice-symbol)))
(list (car expr)
(llama--collect (cadr expr) args nil nil t)))
((memq (car-safe expr)
(list backquote-backquote-symbol
backquote-splice-symbol))
(list (car expr)
(llama--collect (cadr expr) args nil t)))
((symbolp expr)
(let ((name (symbol-name expr)))
(save-match-data
(cond
((string-match "\\`\\(_\\)?[%&]\\([1-9*]\\)?\\'" name)
(let* ((pos (match-string 2 name))
(pos (cond ((equal pos "*") 0)
((not pos) 1)
((string-to-number pos))))
(sym (aref args pos)))
(unless (and fnpos (not unquote) (memq expr '(% &)))
(when (and sym (not (equal expr sym)))
(error "`%s' and `%s' are mutually exclusive" sym expr))
(aset args pos expr)))
(if (match-string 1 name)
llama--unused-argument
expr))
(expr)))))
((or (listp expr)
(vectorp expr))
(let* ((vectorp (vectorp expr))
(expr (if vectorp (append expr ()) expr))
(fnpos (and (not vectorp)
(not backquoted)
(ignore-errors (length expr)))) ;proper-list-p
(ret ()))
(catch t
(while t
(let ((elt (llama--collect (car expr) args fnpos backquoted)))
(unless (eq elt llama--unused-argument)
(push elt ret)))
(setq fnpos nil)
(setq expr (cdr expr))
(unless (and expr
(listp expr)
(not (eq (car expr) backquote-unquote-symbol)))
(throw t nil))))
(setq ret (nreverse ret))
(when expr
(setcdr (last ret) (llama--collect expr args nil backquoted)))
(if vectorp (vconcat ret) ret)))
(expr)))
;;; Completion
(define-advice elisp--expect-function-p (:around (fn pos) llama)
"Support function completion directly following `##'."
(or (and (eq (char-before pos) ?#)
(eq (char-before (- pos 1)) ?#))
(and (eq (char-before pos) ?\s)
(eq (char-before (- pos 1)) ?#)
(eq (char-before (- pos 2)) ?#))
(funcall fn pos)))
(define-advice all-completions (:around (fn str table &rest rest) llama)
"Remove empty symbol from completion results if originating from `llama'.
`##' is the notation for the symbol whose name is the empty string.
(intern \"\") => ##
(symbol-name \\='##) => \"\"
The `llama' package uses `##' as the name of a macro, which allows
it to be used akin to syntax, without actually being new syntax.
\(`describe-function' won't let you select `##', but because that is an
alias for `llama', you can access the documentation under that name.)
This advice prevents the empty string from being offered as a completion
candidate when `obarray' or a completion table that internally uses
that is used as TABLE."
(let ((result (apply fn str table rest)))
(if (and (eq obarray table) (equal str ""))
(delete "" result)
result)))
;;; Fontification
(defgroup llama ()
"Compact syntax for short lambda."
:group 'extensions
:group 'faces
:group 'lisp)
(defface llama-\#\#-macro '((t :inherit font-lock-function-call-face))
"Face used for the name of the `##' macro.")
(defface llama-llama-macro '((t :inherit font-lock-keyword-face))
"Face used for the name of the `llama' macro.")
(defface llama-mandatory-argument '((t :inherit font-lock-variable-use-face))
"Face used for mandatory arguments `%1' through `%9' and `%'.")
(defface llama-optional-argument '((t :inherit font-lock-type-face))
"Face used for optional arguments `&1' through `&9', `&' and `&*'.")
(defface llama-deleted-argument
`((((supports :box t))
:box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1)
:color "red"
:style nil))
(((supports :underline t))
:underline "red")
(t
:inherit font-lock-warning-face))
"Face used for deleted arguments `_%1'...`_%9', `_&1'...`_&9' and `_&*'.
This face is used in addition to one of llama's other argument faces.
Unlike implicit unused arguments (which do not appear in the function
body), these arguments are deleted from the function body during macro
expansion, and the looks of this face should hint at that.")
(defconst llama-font-lock-keywords-28
'(("(\\(##\\)" 1 'llama-\#\#-macro)
("(\\(llama\\)\\_>" 1 'llama-llama-macro)
("\\_<\\(?:_?%[1-9]?\\)\\_>"
0 (llama--maybe-face 'llama-mandatory-argument))
("\\_<\\(?:_?&[1-9*]?\\)\\_>"
0 (llama--maybe-face 'llama-optional-argument))
("\\_<\\(?:_\\(?:%[1-9]?\\|&[1-9*]?\\)\\)\\_>"
0 'llama-deleted-argument prepend)))
(defconst llama-font-lock-keywords-29
`(("\\_<\\(&[1-9*]?\\)\\_>" 1 'default)
(,(apply-partially #'llama--match-and-fontify "(\\(##\\)")
1 'llama-\#\#-macro)
(,(apply-partially #'llama--match-and-fontify "(\\(llama\\_>\\)")
1 'llama-llama-macro)))
(defvar llama-font-lock-keywords
(if (fboundp 'read-positioning-symbols)
llama-font-lock-keywords-29
llama-font-lock-keywords-28))
(defun llama--maybe-face (face)
(and (not (and (member (match-string 0) '("%" "&"))
(and-let* ((beg (ignore-errors
(scan-lists (match-beginning 0) -1 1))))
(string-match-p "\\`\\(##\\|llama\\_>\\)?[\s\t\n\r]*\\'"
(buffer-substring-no-properties
(1+ beg) (match-beginning 0))))))
face))
(defun llama--match-and-fontify (re end)
(static-if (fboundp 'bare-symbol)
(and (re-search-forward re end t)
(prog1 t
(save-excursion
(goto-char (match-beginning 0))
(when-let ((_(save-match-data (not (nth 8 (syntax-ppss)))))
(expr (ignore-errors
(read-positioning-symbols (current-buffer)))))
(put-text-property (match-beginning 0) (point)
'font-lock-multiline t)
(llama--fontify (cdr expr) nil nil t)))))
(list re end))) ; Silence compiler.
(defun llama--fontify (expr &optional fnpos backquoted top)
(static-if (fboundp 'bare-symbol)
(cond
((null expr) expr)
((eq (car-safe expr) 'quote))
((eq (ignore-errors (bare-symbol (car-safe expr))) 'quote))
((and (memq (ignore-errors (bare-symbol (car-safe expr)))
(list (intern "") 'llama))
(not top)))
((and backquoted (symbol-with-pos-p expr)))
((and backquoted
(memq (car-safe expr)
(list backquote-unquote-symbol
backquote-splice-symbol)))
(llama--fontify expr))
((symbol-with-pos-p expr)
(save-match-data
(when-let*
((name (symbol-name (bare-symbol expr)))
(face (cond
((and (string-match
"\\_<\\(?:\\(_\\)?%\\([1-9]\\)?\\)\\_>" name)
(or (not fnpos) (match-end 2)))
'llama-mandatory-argument)
((and (string-match
"\\_<\\(?:\\(_\\)?&\\([1-9*]\\)?\\)\\_>" name)
(or (not fnpos) (match-end 2)))
'llama-optional-argument))))
(when (match-end 1)
(setq face (list 'llama-deleted-argument face)))
(let ((beg (symbol-with-pos-pos expr)))
(put-text-property
beg (save-excursion (goto-char beg) (forward-symbol 1))
'face face)))))
((or (listp expr)
(vectorp expr))
(let* ((vectorp (vectorp expr))
(expr (if vectorp (append expr ()) expr))
(fnpos (and (not vectorp)
(not backquoted)
(ignore-errors (length expr)))))
(catch t
(while t
(cond ((eq (car expr) backquote-backquote-symbol)
(setq expr (cdr expr))
(llama--fontify (car expr) t t))
((llama--fontify (car expr) fnpos backquoted)))
(setq fnpos nil)
(setq expr (cdr expr))
(unless (and expr
(listp expr)
(not (eq (car expr) backquote-unquote-symbol)))
(throw t nil))))
(when expr
(llama--fontify expr fnpos))))))
(list expr fnpos backquoted top)) ; Silence compiler.
(defvar llama-fontify-mode-lighter nil)
;;;###autoload
(define-minor-mode llama-fontify-mode
"In Emacs Lisp mode, highlight the `##' macro and its special arguments."
:lighter llama-fontify-mode-lighter
:global t
(cond
(llama-fontify-mode
(advice-add 'lisp--el-match-keyword :override
#'lisp--el-match-keyword@llama '((depth . -80)))
(advice-add 'elisp-mode-syntax-propertize :override
#'elisp-mode-syntax-propertize@llama)
(add-hook 'emacs-lisp-mode-hook #'llama--add-font-lock-keywords))
(t
(advice-remove 'lisp--el-match-keyword
#'lisp--el-match-keyword@llama)
(advice-remove 'elisp-mode-syntax-propertize
#'elisp-mode-syntax-propertize@llama)
(remove-hook 'emacs-lisp-mode-hook #'llama--add-font-lock-keywords)))
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'emacs-lisp-mode)
(if llama-fontify-mode
(font-lock-add-keywords nil llama-font-lock-keywords)
(font-lock-remove-keywords nil llama-font-lock-keywords))
(font-lock-flush)))))
(defun llama--add-font-lock-keywords ()
(font-lock-add-keywords nil llama-font-lock-keywords))
(defun lisp--el-match-keyword@llama (limit)
"Highlight symbols following \"(##\" the same as if they followed \"(\"."
(catch 'found
(while (re-search-forward
(concat "(\\(?:## ?\\)?\\("
(static-if (get 'lisp-mode-symbol 'rx-definition) ;>= 29.1
(rx lisp-mode-symbol)
lisp-mode-symbol-regexp)
"\\)\\_>")
limit t)
(let ((sym (intern-soft (match-string 1))))
(when (and (or (special-form-p sym)
(macrop sym)
(and (bound-and-true-p morlock-mode)
;; Same as in advice of `morlock' package.
(get sym 'morlock-font-lock-keyword)))
(not (get sym 'no-font-lock-keyword))
(static-if (fboundp 'lisp--el-funcall-position-p) ;>= 28.1
(lisp--el-funcall-position-p (match-beginning 0))
(not (lisp--el-non-funcall-position-p
(match-beginning 0)))))
(throw 'found t))))))
(defun elisp-mode-syntax-propertize@llama (start end)
;; Synced with Emacs up to 6b9510d94f814cacf43793dce76250b5f7e6f64a.
"Highlight `##' as the symbol which it is."
(goto-char start)
(let ((case-fold-search nil))
(funcall
(syntax-propertize-rules
;; Empty symbol.
;; {{ Comment out to prevent the `##' from becoming part of
;; the following symbol when there is no space in between.
;; ("##" (0 (unless (nth 8 (syntax-ppss))
;; (string-to-syntax "_"))))
;; }}
;; {{ As for other symbols, use `font-lock-constant-face' in
;; docstrings and comments.
("##" (0 (when (nth 8 (syntax-ppss))
(string-to-syntax "_"))))
;; }}
;; {{ Preserve this part, even though it is absent from
;; this function in 29.1; backporting it by association.
;; Prevent the @ from becoming part of a following symbol.
(",@" (0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "'"))))
;; }}
;; Unicode character names. (The longest name is 88 characters
;; long.)
("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}"
(0 (unless (nth 8 (syntax-ppss))
(string-to-syntax "_"))))
((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector.
(seq (group-n 1 "s") "(") ; Record.
(seq (group-n 1 (+ "^")) "["))) ; Char-table.
(1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
(string-to-syntax "'")))))
start end)))
;;; Partial applications
(defun llama--left-apply-partially (fn &rest args)
"Return a function that is a partial application of FN to ARGS.
ARGS is a list of the first N arguments to pass to FN. The result
is a new function which does the same as FN, except that the first N
arguments are fixed at the values with which this function was called.
See also `llama--right-apply-partially', which instead fixes the last
N arguments.
These functions are intended to be used using the names `partial' and
`rpartial'. To be able to use these shorthands in a file, you must set
the file-local value of `read-symbols-shorthands', which was added in
Emacs 28.1. For an example see the end of file \"llama.el\".
This is an alternative to `apply-partially', whose name is too long."
(declare (pure t) (side-effect-free error-free))
(lambda (&rest args2)
(apply fn (append args args2))))
(defun llama--right-apply-partially (fn &rest args)
"Return a function that is a right partial application of FN to ARGS.
ARGS is a list of the last N arguments to pass to FN. The result
is a new function which does the same as FN, except that the last N
arguments are fixed at the values with which this function was called.
See also `llama--left-apply-partially', which instead fixes the first
N arguments.
These functions are intended to be used using the names `rpartial' and
`partial'. To be able to use these shorthands in a file, you must set
the file-local value of `read-symbols-shorthands', which was added in
Emacs 28.1. For an example see the end of file \"llama.el\"."
(declare (pure t) (side-effect-free error-free))
(lambda (&rest args2)
(apply fn (append args2 args))))
;; An example of how one would use these functions:
;;
;; (list (funcall (partial (lambda (a b) (list a b)) 'fixed) 'after)
;; (funcall (rpartial (lambda (a b) (list a b)) 'fixed) 'before))
;; An example of the configuration that is necessary to enable this:
;;
;; Local Variables:
;; indent-tabs-mode: nil
;; read-symbol-shorthands: (
;; ("partial" . "llama--left-apply-partially")
;; ("rpartial" . "llama--right-apply-partially"))
;; End:
;;
;; Do not set `read-symbol-shorthands' in the ".dir-locals.el"
;; file, because that does not work for uncompiled libraries.
(provide 'llama)
;;; llama.el ends here

Binary file not shown.

View File

@@ -0,0 +1,19 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Magit-Section: (magit-section).
Use Magit sections in your own packages.

View File

@@ -0,0 +1,67 @@
;;; magit-section-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from magit-section.el
(autoload 'magit-add-section-hook "magit-section" "\
Add to the value of section hook HOOK the function FUNCTION.
Add FUNCTION at the beginning of the hook list unless optional
APPEND is non-nil, in which case FUNCTION is added at the end.
If FUNCTION already is a member, then move it to the new location.
If optional AT is non-nil and a member of the hook list, then
add FUNCTION next to that instead. Add before or after AT, or
replace AT with FUNCTION depending on APPEND. If APPEND is the
symbol `replace', then replace AT with FUNCTION. For any other
non-nil value place FUNCTION right after AT. If nil, then place
FUNCTION right before AT. If FUNCTION already is a member of the
list but AT is not, then leave FUNCTION where ever it already is.
If optional LOCAL is non-nil, then modify the hook's buffer-local
value rather than its global value. This makes the hook local by
copying the default value. That copy is then modified.
HOOK should be a symbol. If HOOK is void, it is first set to nil.
HOOK's value must not be a single hook function. FUNCTION should
be a function that takes no arguments and inserts one or multiple
sections at point, moving point forward. FUNCTION may choose not
to insert its section(s), when doing so would not make sense. It
should not be abused for other side-effects. To remove FUNCTION
again use `remove-hook'.
(fn HOOK FUNCTION &optional AT APPEND LOCAL)")
(autoload 'magit--handle-bookmark "magit-section" "\
Open a bookmark created by `magit--make-bookmark'.
Call the generic function `magit-bookmark-get-buffer-create' to get
the appropriate buffer without displaying it.
Then call the `magit-*-setup-buffer' function of the the major-mode
with the variables' values as arguments, which were recorded by
`magit--make-bookmark'.
(fn BOOKMARK)")
(register-definition-prefixes "magit-section" '("context-menu-region" "isearch-clean-overlays" "magit-"))
;;; End of scraped data
(provide 'magit-section-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; magit-section-autoloads.el ends here

View File

@@ -0,0 +1,14 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "magit-section" "20251220.917"
"Sections for read-only buffers."
'((emacs "28.1")
(compat "30.1")
(cond-let "0.1")
(llama "1.0")
(seq "2.24"))
:url "https://github.com/magit/magit"
:commit "649b4c972151c0ee495876c0d4c8c13787614886"
:revdesc "649b4c972151"
:keywords '("tools")
:authors '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev"))
:maintainers '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")))

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -0,0 +1,320 @@
This is magit-section.info, produced by makeinfo version 6.8 from
magit-section.texi.
Copyright (C) 2015-2025 Jonas Bernoulli
<emacs.magit@jonas.bernoulli.dev>
You can redistribute this document 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 document 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.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Magit-Section: (magit-section). Use Magit sections in your own packages.
END-INFO-DIR-ENTRY

File: magit-section.info, Node: Top, Next: Introduction, Up: (dir)
Magit-Section Developer Manual
******************************
This package implements the main user interface of Magit — the
collapsible sections that make up its buffers. This package used to be
distributed as part of Magit but how it can also be used by other
packages that have nothing to do with Magit or Git.
To learn more about the section abstraction and available commands
and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages.
This manual is for Magit-Section version 4.4.2.
Copyright (C) 2015-2025 Jonas Bernoulli
<emacs.magit@jonas.bernoulli.dev>
You can redistribute this document 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 document 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.
* Menu:
* Introduction::
* Creating Sections::
* Core Functions::
* Matching Functions::

File: magit-section.info, Node: Introduction, Next: Creating Sections, Prev: Top, Up: Top
1 Introduction
**************
This package implements the main user interface of Magit — the
collapsible sections that make up its buffers. This package used to be
distributed as part of Magit but how it can also be used by other
packages that have nothing to do with Magit or Git.
To learn more about the section abstraction and available commands
and user options see *note (magit)Sections::. This manual documents how
you can use sections in your own packages.
When the documentation leaves something unaddressed, then please
consider that Magit uses this library extensively and search its source
for suitable examples before asking me for help. Thanks!

File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev: Introduction, Up: Top
2 Creating Sections
*******************
-- Macro: magit-insert-section [name] (type &optional value hide) &rest
body
Create a section object of type CLASS, storing VALUE in its value
slot, and insert the section at point. CLASS is a subclass of
magit-section or has the form (eval FORM), in which case FORM
is evaluated at runtime and should return a subclass. In other
places a sections class is often referred to as its "type".
Many commands behave differently depending on the class of the
current section and sections of a certain class can have their own
keymap, which is specified using the keymap class slot. The
value of that slot should be a variable whose value is a keymap.
For historic reasons Magit and Forge in most cases use symbols as
CLASS that dont actually identify a class and that lack the
appropriate package prefix. This works due to some undocumented
kludges, which are not available to other packages.
When optional HIDE is non-nil collapse the section body by
default, i.e., when first creating the section, but not when
refreshing the buffer. Else expand it by default. This can be
overwritten using magit-section-set-visibility-hook. When a
section is recreated during a refresh, then the visibility of
predecessor is inherited and HIDE is ignored (but the hook is still
honored).
BODY is any number of forms that actually insert the sections
heading and body. Optional NAME, if specified, has to be a symbol,
which is then bound to the object of the section being inserted.
Before BODY is evaluated the start of the section object is set
to the value of point and after BODY was evaluated its end is
set to the new value of point; BODY is responsible for moving
point forward.
If it turns out inside BODY that the section is empty, then
magit-cancel-section can be used to abort and remove all traces
of the partially inserted section. This can happen when creating a
section by washing Gits output and Git didnt actually output
anything this time around.
-- Function: magit-insert-heading [child-count] &rest args
Insert the heading for the section currently being inserted.
This function should only be used inside magit-insert-section.
When called without any arguments, then just set the content slot
of the object representing the section being inserted to a marker
at point. The section should only contain a single line when
this function is used like this.
When called with arguments ARGS, which have to be strings, or
nil, then insert those strings at point. The section should not
contain any text before this happens and afterwards it should again
only contain a single line. If the face property is set anywhere
inside any of these strings, then insert all of them unchanged.
Otherwise use the magit-section-heading face for all inserted
text.
The content property of the section object is the end of the
heading (which lasts from start to content) and the beginning
of the the body (which lasts from content to end). If the
value of content is nil, then the section has no heading and
its body cannot be collapsed. If a section does have a heading,
then its height must be exactly one line, including a trailing
newline character. This isnt enforced, you are responsible for
getting it right. The only exception is that this function does
insert a newline character if necessary.
If provided, optional CHILD-COUNT must evaluate to an integer or
boolean. If t, then the count is determined once the children
have been inserted, using magit-insert-child-count (which see).
For historic reasons, if the heading ends with ":", the count is
substituted for that, at this time as well. If
magit-section-show-child-count is nil, no counts are inserted
-- Macro: magit-insert-section-body &rest body
Use BODY to insert the section body, once the section is expanded.
If the section is expanded when it is created, then this is like
progn. Otherwise BODY isnt evaluated until the section is
explicitly expanded.
-- Function: magit-cancel-section
Cancel inserting the section that is currently being inserted.
Remove all traces of that section.
-- Function: magit-wash-sequence function
Repeatedly call FUNCTION until it returns nil or the end of the
buffer is reached. FUNCTION has to move point forward or return
nil.

File: magit-section.info, Node: Core Functions, Next: Matching Functions, Prev: Creating Sections, Up: Top
3 Core Functions
****************
-- Function: magit-current-section
Return the section at point or where the context menu was invoked.
When using the context menu, return the section that the user
clicked on, provided the current buffer is the buffer in which the
click occurred. Otherwise return the section at point.
Function magit-section-at &optional position
Return the section at POSITION, defaulting to point. Default to
point even when the context menu is used.
-- Function: magit-section-ident section
Return an unique identifier for SECTION. The return value has the
form ((TYPE . VALUE)...).
-- Function: magit-section-ident-value value
Return a constant representation of VALUE.
VALUE is the value of a magit-section object. If that is an
object itself, then that is not suitable to be used to identify the
section because two objects may represent the same thing but not be
equal. If possible a method should be added for such objects,
which returns a value that is equal. Otherwise the catch-all
method is used, which just returns the argument itself.
-- Function: magit-get-section ident &optional root
Return the section identified by IDENT. IDENT has to be a list as
returned by magit-section-ident. If optional ROOT is non-nil,
then search in that section tree instead of in the one whose root
magit-root-section is.
-- Function: magit-section-lineage section &optional raw
Return the lineage of SECTION. If optional RAW is non-nil,
return a list of section objects, beginning with SECTION, otherwise
return a list of section types.
-- Function: magit-section-content-p section
Return non-nil if SECTION has content or an unused washer
function.
The next two functions are replacements for the Emacs functions that
have the same name except for the magit- prefix. Like
magit-current-section they do not act on point, the cursors position,
but on the position where the user clicked to invoke the context menu.
If your package provides a context menu and some of its commands act
on the "thing at point", even if just as a default, then use the
prefixed functions to teach them to instead use the click location when
appropriate.
Function magit-point
Return point or the position where the context menu was invoked.
When using the context menu, return the position the user clicked
on, provided the current buffer is the buffer in which the click
occurred. Otherwise return the same value as point.
Function magit-thing-at-point thing &optional no-properties
Return the THING at point or where the context menu was invoked.
When using the context menu, return the thing the user clicked on,
provided the current buffer is the buffer in which the click
occurred. Otherwise return the same value as thing-at-point.
For the meaning of THING and NO-PROPERTIES see that function.

File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up: Top
4 Matching Functions
********************
-- Function: magit-section-match condition &optional (section
(magit-current-section))
Return t if SECTION matches CONDITION.
SECTION defaults to the section at point. If SECTION is not
specified and there also is no section at point, then return nil.
CONDITION can take the following forms:
(CONDITION...) matches if any of the CONDITIONs matches.
[CLASS...] matches if the sections class is the same as the
first CLASS or a subclass of that; the sections parent class
matches the second CLASS; and so on.
[* CLASS...] matches sections that match [CLASS...] and also
recursively all their child sections.
CLASS matches if the sections class is the same as CLASS or
a subclass of that; regardless of the classes of the parent
sections.
Each CLASS should be a class symbol, identifying a class that
derives from magit-section. For backward compatibility CLASS can
also be a "type symbol". A section matches such a symbol if the
value of its type slot is eq. If a type symbol has an entry in
magit--section-type-alist, then a section also matches that type
if its class is a subclass of the class that corresponds to the
type as per that alist.
Note that it is not necessary to specify the complete section
lineage as printed by magit-describe-section-briefly, unless of
course you want to be that precise.
-- Function: magit-section-value-if condition &optional section
If the section at point matches CONDITION, then return its value.
If optional SECTION is non-nil then test whether that matches
instead. If there is no section at point and SECTION is nil,
then return nil. If the section does not match, then return
nil.
See magit-section-match for the forms CONDITION can take.
-- Macro: magit-section-case &rest clauses
Choose among clauses on the type of the section at point.
Each clause looks like (CONDITION BODY...). The type of the
section is compared against each CONDITION; the BODY forms of the
first match are evaluated sequentially and the value of the last
form is returned. Inside BODY the symbol it is bound to the
section at point. If no clause succeeds or if there is no section
at point, return nil.
See magit-section-match for the forms CONDITION can take.
Additionally a CONDITION of t is allowed in the final clause, and
matches if no other CONDITION match, even if there is no section at
point.

Tag Table:
Node: Top808
Node: Introduction2109
Node: Creating Sections2879
Node: Core Functions7846
Node: Matching Functions11021

End Tag Table

Local Variables:
coding: utf-8
End:

View File

@@ -0,0 +1,18 @@
This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.

File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Org-roam: (org-roam). Roam Research for Emacs.

View File

@@ -0,0 +1,331 @@
;;; org-roam-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from org-roam.el
(autoload 'org-roam-list-files "org-roam" "\
Return a list of all Org-roam files under `org-roam-directory'.
See `org-roam-file-p' for how each file is determined to be as
part of Org-Roam.")
(register-definition-prefixes "org-roam" '("org-roam-"))
;;; Generated autoloads from org-roam-capture.el
(autoload 'org-roam-capture- "org-roam-capture" "\
Main entry point of `org-roam-capture' module.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates.
(fn &key GOTO KEYS NODE INFO PROPS TEMPLATES)")
(autoload 'org-roam-capture "org-roam-capture" "\
Launches an `org-capture' process for a new or existing node.
This uses the templates defined at `org-roam-capture-templates'.
Arguments GOTO and KEYS see `org-capture'.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)
The INFO, if provided, is passed along to the underlying `org-roam-capture-'.
(fn &optional GOTO KEYS &key FILTER-FN TEMPLATES INFO)" t)
(register-definition-prefixes "org-roam-capture" '("org-roam-capture-"))
;;; Generated autoloads from org-roam-compat.el
(autoload 'org-roam-db-autosync-enable "org-roam-compat" "\
Activate `org-roam-db-autosync-mode'.")
(make-obsolete 'org-roam-db-autosync-enable 'org-roam-db-autosync-mode "2025-11-23")
(register-definition-prefixes "org-roam-compat" '("org-roam-"))
;;; Generated autoloads from org-roam-dailies.el
(autoload 'org-roam-dailies-capture-today "org-roam-dailies" "\
Create an entry in the daily-note for today.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn &optional GOTO KEYS)" t)
(autoload 'org-roam-dailies-goto-today "org-roam-dailies" "\
Find the daily-note for today, creating it if necessary.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn &optional KEYS)" t)
(autoload 'org-roam-dailies-capture-tomorrow "org-roam-dailies" "\
Create an entry in the daily-note for tomorrow.
With numeric argument N, use the daily-note N days in the future.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn N &optional GOTO KEYS)" t)
(autoload 'org-roam-dailies-goto-tomorrow "org-roam-dailies" "\
Find the daily-note for tomorrow, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn N &optional KEYS)" t)
(autoload 'org-roam-dailies-capture-yesterday "org-roam-dailies" "\
Create an entry in the daily-note for yesteday.
With numeric argument N, use the daily-note N days in the past.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn N &optional GOTO KEYS)" t)
(autoload 'org-roam-dailies-goto-yesterday "org-roam-dailies" "\
Find the daily-note for yesterday, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn N &optional KEYS)" t)
(autoload 'org-roam-dailies-capture-date "org-roam-dailies" "\
Create an entry in the daily-note for a date using the calendar.
Prefer past dates, unless PREFER-FUTURE is non-nil.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn &optional GOTO PREFER-FUTURE KEYS)" t)
(autoload 'org-roam-dailies-goto-date "org-roam-dailies" "\
Find the daily-note for a date using the calendar, creating it if necessary.
Prefer past dates, unless PREFER-FUTURE is non-nil.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed.
(fn &optional PREFER-FUTURE KEYS)" t)
(autoload 'org-roam-dailies-find-directory "org-roam-dailies" "\
Find and open `org-roam-dailies-directory'." t)
(register-definition-prefixes "org-roam-dailies" '("org-roam-dailies-"))
;;; Generated autoloads from org-roam-db.el
(autoload 'org-roam-db-sync "org-roam-db" "\
Synchronize the cache state with the current Org files on-disk.
If FORCE, force a rebuild of the cache from scratch.
(fn &optional FORCE)" t)
(defvar org-roam-db-autosync-mode nil "\
Non-nil if Org-Roam-Db-Autosync mode is enabled.
See the `org-roam-db-autosync-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `org-roam-db-autosync-mode'.")
(custom-autoload 'org-roam-db-autosync-mode "org-roam-db" nil)
(autoload 'org-roam-db-autosync-mode "org-roam-db" "\
Global minor mode to keep your Org-roam session automatically synchronized.
Through the session this will continue to setup your
buffers (that are Org-roam file visiting), keep track of the
related changes, maintain cache consistency and incrementally
update the currently active database.
If you need to manually trigger resync of the currently active
database, see `org-roam-db-sync' command.
This is a global minor mode. If called interactively, toggle the
`Org-Roam-Db-Autosync mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable the
mode if ARG is nil, omitted, or is a positive number. Disable the mode
if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `(default-value \\='org-roam-db-autosync-mode)'.
The mode's hook is called both when the mode is enabled and when it is
disabled.
(fn &optional ARG)" t)
(register-definition-prefixes "org-roam-db" '("emacsql-constraint" "org-roam-db"))
;;; Generated autoloads from org-roam-export.el
(register-definition-prefixes "org-roam-export" '("org-roam-export--org-html--reference"))
;;; Generated autoloads from org-roam-graph.el
(autoload 'org-roam-graph "org-roam-graph" "\
Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps.
(fn &optional ARG NODE)" t)
(register-definition-prefixes "org-roam-graph" '("org-roam-"))
;;; Generated autoloads from org-roam-id.el
(autoload 'org-roam-update-org-id-locations "org-roam-id" "\
Scan Org-roam files to update `org-id' related state.
This is like `org-id-update-id-locations', but will automatically
use the currently bound `org-directory' and `org-roam-directory'
along with DIRECTORIES (if any), where the lookup for files in
these directories will be always recursive.
Note: Org-roam doesn't have hard dependency on
`org-id-locations-file' to lookup IDs for nodes that are stored
in the database, but it still tries to properly integrates with
`org-id'. This allows the user to cross-reference IDs outside of
the current `org-roam-directory', and also link with \"id:\"
links to headings/files within the current `org-roam-directory'
that are excluded from identification in Org-roam as
`org-roam-node's, e.g. with \"ROAM_EXCLUDE\" property.
(fn &rest DIRECTORIES)" t)
(register-definition-prefixes "org-roam-id" '("org-roam-id-"))
;;; Generated autoloads from org-roam-log.el
(register-definition-prefixes "org-roam-log" '("org-roam-log-"))
;;; Generated autoloads from org-roam-migrate.el
(autoload 'org-roam-migrate-wizard "org-roam-migrate" "\
Migrate all notes from to be compatible with Org-roam v2.
1. Convert all notes from v1 format to v2.
2. Rebuild the cache.
3. Replace all file links with ID links." t)
(register-definition-prefixes "org-roam-migrate" '("org-roam-migrate-"))
;;; Generated autoloads from org-roam-mode.el
(autoload 'org-roam-buffer-display-dedicated "org-roam-mode" "\
Launch NODE dedicated Org-roam buffer.
Unlike the persistent `org-roam-buffer', the contents of this
buffer won't be automatically changed and will be held in place.
In interactive calls prompt to select NODE, unless called with
`universal-argument', in which case NODE will be set to
`org-roam-node-at-point'.
(fn NODE)" t)
(register-definition-prefixes "org-roam-mode" '("org-roam-"))
;;; Generated autoloads from org-roam-node.el
(autoload 'org-roam-node-find "org-roam-node" "\
Find and open an Org-roam node by its title or alias.
INITIAL-INPUT is the initial input for the prompt.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
If OTHER-WINDOW, visit the NODE in another window.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)
(fn &optional OTHER-WINDOW INITIAL-INPUT FILTER-FN PRED &key TEMPLATES)" t)
(autoload 'org-roam-node-random "org-roam-node" "\
Find and open a random Org-roam node.
With prefix argument OTHER-WINDOW, visit the node in another
window instead.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
(fn &optional OTHER-WINDOW FILTER-FN)" t)
(autoload 'org-roam-node-insert "org-roam-node" "\
Find an Org-roam node and insert (where the point is) an \"id:\" link to it.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)
The INFO, if provided, is passed to the underlying `org-roam-capture-'.
(fn &optional FILTER-FN &key TEMPLATES INFO)" t)
(autoload 'org-roam-refile "org-roam-node" "\
Refile node at point to an org-roam NODE.
If region is active, then use it instead of the node at point.
(fn NODE)" t)
(autoload 'org-roam-extract-subtree "org-roam-node" "\
Convert current subtree at point to a node, and extract it into a new file." t)
(autoload 'org-roam-ref-find "org-roam-node" "\
Find and open an Org-roam node that's dedicated to a specific ref.
INITIAL-INPUT is the initial input to the prompt.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
(fn &optional INITIAL-INPUT FILTER-FN)" t)
(register-definition-prefixes "org-roam-node" '("org-roam-"))
;;; Generated autoloads from org-roam-overlay.el
(register-definition-prefixes "org-roam-overlay" '("org-roam-overlay-"))
;;; Generated autoloads from org-roam-protocol.el
(register-definition-prefixes "org-roam-protocol" '("org-roam-"))
;;; Generated autoloads from org-roam-utils.el
(autoload 'org-roam-version "org-roam-utils" "\
Return `org-roam' version.
Interactively, or when MESSAGE is non-nil, show in the echo area.
(fn &optional MESSAGE)" t)
(autoload 'org-roam-diagnostics "org-roam-utils" "\
Collect and print info for `org-roam' issues." t)
(register-definition-prefixes "org-roam-utils" '("org-roam-"))
;;; End of scraped data
(provide 'org-roam-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; org-roam-autoloads.el ends here

View File

@@ -0,0 +1,843 @@
;;; org-roam-capture.el --- Capture functionality -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This module provides `org-capture' functionality for Org-roam. With this
;; module the user can capture new nodes or capture new content to existing
;; nodes.
;;
;;; Code:
(require 'org-roam)
;;;; Declarations
(defvar org-end-time-was-given)
;;; Options
(defcustom org-roam-capture-templates
'(("d" "default" plain "%?"
:target (file+head "%<%Y%m%d%H%M%S>-${slug}.org"
"#+title: ${title}\n")
:unnarrowed t))
"Templates for the creation of new entries within Org-roam.
Each entry is a list with the following items:
keys The keys that will select the template, as a string, characters only, for
example \"a\" for a template to be selected with a single key, or
\"bt\" for selection with two keys. When using several keys, keys
using the same prefix must be together in the list and preceded by a
2-element entry explaining the prefix key, for example:
(\"b\" \"Templates for marking stuff to buy\")
The \"C\" key is used by default for quick access to the customization of
the template variable. But if you want to use that key for a template,
you can.
description A short string describing the template, which will be shown
during selection.
type The type of entry. Valid types are:
entry an Org node, with a headline. Will be filed
as the child of the target entry or as a
top level entry. Its default template is:
\"* %?\n %a\"
item a plain list item, will be placed in the
first plain list at the target location.
Its default template is:
\"- %?\"
checkitem a checkbox item. This differs from the
plain list item only in so far as it uses a
different default template. Its default
template is:
\"- [ ] %?\"
table-line a new line in the first table at target location.
Its default template is:
\"| %? |\"
plain text to be inserted as it is.
template The template for creating the capture item.
If it is an empty string or nil, a default template based on
the entry type will be used (see the \"type\" section above).
Instead of a string, this may also be one of:
(file \"/path/to/template-file\")
(function function-returning-the-template)
in order to get a template from a file, or dynamically
from a function.
The template contains a compulsory :target property. The :target property
contains a list, where:
- The first element indicates the type of the target.
- The second element indicates the location of the captured node.
- And the rest of the list indicate the prefilled template, that will be
inserted and the position of the point will be adjusted for.
This behavior varies from type to type.
The following options are supported for the :target property:
(file \"path/to/file\")
The file will be created, and prescribed an ID.
(file+head \"path/to/file\" \"head content\")
The file will be created, prescribed an ID, and head content will be
inserted if the node is a newly captured one.
(file+olp \"path/to/file\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. If the file doesn't contain
the outline path (h1, h2), it will be automatically created. The point
will be adjusted to the last element in the OLP.
(file+head+olp \"path/to/file\" \"head content\" (\"h1\" \"h2\"))
The file will be created, prescribed an ID. Head content will be
inserted at the start of the file if the node is a newly captured one.
If the file doesn't contain the outline path (h1, h2), it will be
automatically created. The point will be adjusted to the last element in
the OLP.
(file+datetree \"path/to/file\" tree-type)
The file will be created, prescribed an ID. A date based outline path
will be created for today's date. The tree-type can be one of the
following symbols: day, week or month. The point will adjusted to the
last element in the tree. To prompt for date instead of using today's,
use the :time-prompt property.
(node \"title or alias or ID of an existing node\")
The point will be placed for an existing node, based on either, its
title, alias or ID.
The rest of the entry is a property list of additional options. Recognized
properties are:
:prepend Normally newly captured information will be appended at
the target location (last child, last table line,
last list item...). Setting this property will
change that.
:immediate-finish When set, do not offer to edit the information, just
file it away immediately. This makes sense if the
template only needs information that can be added
automatically.
:jump-to-captured When set, jump to the captured entry when finished.
:empty-lines Set this to the number of lines that should be inserted
before and after the new item. Default 0, only common
other value is 1.
:empty-lines-before Set this to the number of lines that should be inserted
before the new item. Overrides :empty-lines for the
number lines inserted before.
:empty-lines-after Set this to the number of lines that should be inserted
after the new item. Overrides :empty-lines for the
number of lines inserted after.
:clock-in Start the clock in this item.
:clock-keep Keep the clock running when filing the captured entry.
:clock-resume Start the interrupted clock when finishing the capture.
Note that :clock-keep has precedence over :clock-resume.
When setting both to t, the current clock will run and
the previous one will not be resumed.
:time-prompt Prompt for a date/time to be used for date/week trees
and when filling the template.
:tree-type When `week', make a week tree instead of the month-day
tree. When `month', make a month tree instead of the
month-day tree.
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
only see the new stuff.
:table-line-pos Specification of the location in the table where the
new line should be inserted. It should be a string like
\"II-3\", meaning that the new line should become the
third line before the second horizontal separator line.
:kill-buffer If the target file was not yet visited by a buffer when
capture was invoked, kill the buffer again after capture
is finalized.
:no-save Do not save the target file after finishing the capture.
The template defines the text to be inserted. Often this is an
Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
be replaced with content and expanded:
%[pathname] Insert the contents of the file given by
`pathname'. These placeholders are expanded at the very
beginning of the process so they can be used to extend the
current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results.
Only placeholders pre-existing within the template, or
introduced with %[pathname] are expanded this way. Since this
happens after expanding non-interactive %-escapes, those can
be used to fill the expression.
%<...> The result of `format-time-string' on the ... format
specification.
%t Time stamp, date only. The time stamp is the current time,
except when called from agendas with `\\[org-agenda-capture]' or
with `org-capture-use-agenda-date' set.
%T Time stamp as above, with date and time.
%u, %U Like the above, but inactive time stamps.
%i Initial content, copied from the active region. If
there is text before %i on the same line, such as
indentation, and %i is not inside a %(sexp), that prefix
will be added before every line in the inserted text.
%a Annotation, normally the link created with `org-store-link'.
%A Like %a, but prompt for the description part.
%l Like %a, but only insert the literal link.
%L Like %l, but without brackets (the link content itself).
%c Current kill ring head.
%x Content of the X clipboard.
%k Title of currently clocked task.
%K Link to currently clocked task.
%n User name (taken from the variable `user-full-name').
%f File visited by current buffer when `org-capture' was called.
%F Full path of the file or directory visited by current buffer.
%:keyword Specific information for certain link types, see below.
%^g Prompt for tags, with completion on tags in target file.
%^G Prompt for tags, with completion on all tags in all agenda files.
%^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
You may define a prompt like: %^{Please specify birthday}t.
The default date is that of %t, see above.
%^C Interactive selection of which kill or clip to use.
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
A default value can be specified like this:
%^{prop|default}p.
%^{prompt} Prompt the user for a string and replace this sequence with it.
A default value and a completion table can be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
%\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
is a number, starting from 1.
Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails
or in Gnus will record the author and the subject of the message, which you
can access with \"%:from\" and \"%:subject\", respectively. Here is a
complete list of what is recorded for each link type.
Link type | Available information
------------------------+------------------------------------------------------
bbdb | %:type %:name %:company
vm, wl, mh, mew, rmail, | %:type %:subject %:message-id
gnus | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:fromto (either \"to NAME\" or \"from NAME\")
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
eww, w3, w3m | %:type %:url
info | %:type %:file %:node
calendar | %:type %:date
When you need to insert a literal percent sign in the template,
you can escape ambiguous cases with a backward slash, e.g., \\%i.
In addition to all of the above, Org-roam supports additional
substitutions within its templates. \"${foo}\" will look for the
foo property in the Org-roam node (see the `org-roam-node'). If
the property does not exist, the user will be prompted to fill in
the string value.
Org-roam templates are NOT compatible with regular Org capture:
they rely on additional hacks and hooks to achieve the
streamlined user experience in Org-roam."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
(defcustom org-roam-capture-new-node-hook nil
"Normal-mode hooks run when a new Org-roam node is created.
The current point is the point of the new node.
The hooks must not move the point."
:group 'org-roam
:type 'hook)
(defvar org-roam-capture-preface-hook nil
"Hook run when Org-roam tries to determine capture location of the node.
If any hook returns a value (which should be an ID), all hooks
after it are ignored.
With this hook you can hijack controls over the location of the
node for which the capture process is currently running for, or
use to just perform an arbitrary side effect, e.g. modify the
state related to the capture process. See `org-roam-protocol' and
`org-roam-dailies' as examples for what and how this hook is used
for.
If you're trying to perform the hijack, it's mandatory for you to:
1. Set the currently active buffer for editing operations using
`org-capture-target-buffer'.
2. Place the point in this buffer from where the location starts
from (e.g. if it's a file based node it should be the BOB,
otherwise it should be the position from where the heading
based node starts from).
3. Return the ID (as a string) of the capturing node.
If you use this hook for any other purpose, but not the hijack,
it's mandatory that you should return nil as the return value; so
the capture process would be able to setup the capture buffer.
If you need to do something when you capture new nodes, use
`org-roam-capture-new-node-hook' instead of this hook.
WARNING: This hook is primarily designed for the usage by the
extensions and packages, and requires understanding of the
internal capture process. If you don't understand it, you should
learn these internals before using this or use it at your own
risk breaking things.")
;;; Variables
(defvar org-roam-capture--node nil
"The node passed during an Org-roam capture.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defvar org-roam-capture--info nil
"A property-list of additional information passed to the Org-roam template.
This variable is populated dynamically, and is only non-nil
during the Org-roam capture process.")
(defconst org-roam-capture--template-keywords (list :target :id :link-description :call-location
:region)
"Keywords used in `org-roam-capture-templates' specific to Org-roam.")
;;; Main entry point
;;;###autoload
(cl-defun org-roam-capture- (&key goto keys node info props templates)
"Main entry point of `org-roam-capture' module.
GOTO and KEYS correspond to `org-capture' arguments.
INFO is a plist for filling up Org-roam's capture templates.
NODE is an `org-roam-node' construct containing information about the node.
PROPS is a plist containing additional Org-roam properties for each template.
TEMPLATES is a list of org-roam templates."
(let* ((props (plist-put props :call-location (point-marker)))
(org-capture-templates
(mapcar (lambda (template)
(org-roam-capture--convert-template template props))
(or templates org-roam-capture-templates)))
(_ (setf (org-roam-node-id node) (or (org-roam-node-id node)
(org-id-new))))
(org-roam-capture--node node)
(org-roam-capture--info info))
(when (and (not keys)
(= (length org-capture-templates) 1))
(setq keys (caar org-capture-templates)))
(org-capture goto keys)))
;;;###autoload
(cl-defun org-roam-capture (&optional goto keys &key filter-fn templates info)
"Launches an `org-capture' process for a new or existing node.
This uses the templates defined at `org-roam-capture-templates'.
Arguments GOTO and KEYS see `org-capture'.
FILTER-FN is a function to filter out nodes: it takes an `org-roam-node',
and when nil is returned the node will be filtered out.
The TEMPLATES, if provided, override the list of capture templates (see
`org-roam-capture-'.)
The INFO, if provided, is passed along to the underlying `org-roam-capture-'."
(interactive "P")
(let ((node (org-roam-node-read nil filter-fn)))
(org-roam-capture- :goto goto
:info info
:keys keys
:templates templates
:node node
:props '(:immediate-finish nil))))
;;; Capture process
(defun org-roam-capture-p ()
"Return t if the current capture process is an Org-roam capture.
This function is to only be called when `org-capture-plist' is
valid for the capture (i.e. initialization, and finalization of
the capture)."
(plist-get org-capture-plist :org-roam))
(defun org-roam-capture--get (keyword)
"Get the value for KEYWORD from the `org-roam-capture-template'."
(plist-get (plist-get org-capture-plist :org-roam) keyword))
(defun org-roam-capture--put (prop value)
"Set property PROP to VALUE in the `org-roam-capture-template'."
(let ((p (plist-get org-capture-plist :org-roam)))
(setq org-capture-plist
(plist-put org-capture-plist
:org-roam
(plist-put p prop value)))))
;;;; Capture target
(defun org-roam-capture--prepare-buffer ()
"Prepare the capture buffer for the current Org-roam based capture template.
This function will initialize and setup the capture buffer,
position the point to the current :target (and if necessary,
create it if it doesn't exist), and place the point for further
processing by `org-capture'.
Note: During the capture process this function is run by
`org-capture-set-target-location', as a (function ...) based
capture target."
(if-let* ((id (run-hook-with-args-until-success 'org-roam-capture-preface-hook)))
(org-roam-capture--put :id id)
(org-roam-capture--setup-target-location)
;; Adjust point for plain captures to skip past metadata (e.g. properties drawer)
(org-roam-capture--adjust-point-for-capture-type))
(let ((template (org-capture-get :template)))
(when (stringp template)
(org-capture-put
:template
(org-roam-capture--fill-template template))))
(org-roam-capture--put :finalize (or (org-capture-get :finalize)
(org-roam-capture--get :finalize))))
(defun org-roam-capture--setup-target-location ()
"Initialize the buffer, and goto the location of the new capture."
(let ((target-entry-p t)
p new-file-p id)
(pcase (org-roam-capture--get-target)
(`(file ,path)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(when new-file-p (org-roam-capture--put :new-file path))
(set-buffer (org-capture-target-buffer path))
(widen)
(setq p (goto-char (point-min))
target-entry-p nil))
(`(file+olp ,path ,olp)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(when new-file-p (org-roam-capture--put :new-file path))
(set-buffer (org-capture-target-buffer path))
(setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m))
(widen))
(`(file+head ,path ,head)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(set-buffer (org-capture-target-buffer path))
(when new-file-p
(org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head 'ensure-newline))
(setq p (point-max)))
(widen)
(unless new-file-p
(setq p (goto-char (point-min))))
(setq target-entry-p nil))
(`(file+head+olp ,path ,head ,olp)
(setq path (org-roam-capture--target-truepath path)
new-file-p (org-roam-capture--new-file-p path))
(set-buffer (org-capture-target-buffer path))
(widen)
(when new-file-p
(org-roam-capture--put :new-file path)
(insert (org-roam-capture--fill-template head 'ensure-newline)))
(setq p (point-min))
(let ((m (org-roam-capture-find-or-create-olp olp)))
(goto-char m)))
(`(file+datetree ,path ,tree-type)
(setq path (org-roam-capture--target-truepath path))
(require 'org-datetree)
(widen)
(set-buffer (org-capture-target-buffer path))
(unless (file-exists-p path)
(org-roam-capture--put :new-file path))
(funcall
(pcase tree-type
(`week #'org-datetree-find-iso-week-create)
(`month #'org-datetree-find-month-create)
(_ #'org-datetree-find-date-create))
(calendar-gregorian-from-absolute
(cond
(org-overriding-default-time
;; Use the overriding default time.
(time-to-days org-overriding-default-time))
((org-capture-get :default-time)
(time-to-days (org-capture-get :default-time)))
((org-capture-get :time-prompt)
;; Prompt for date. Bind `org-end-time-was-given' so
;; that `org-read-date-analyze' handles the time range
;; case and returns `prompt-time' with the start value.
(let* ((org-time-was-given nil)
(org-end-time-was-given nil)
(prompt-time (org-read-date
nil t nil "Date for tree entry:")))
(org-capture-put
:default-time
(if (or org-time-was-given
(= (time-to-days prompt-time) (org-today)))
prompt-time
;; Use 00:00 when no time is given for another
;; date than today?
(apply #'encode-time 0 0
org-extend-today-until
(cl-cdddr (decode-time prompt-time)))))
(time-to-days prompt-time)))
(t
;; Current date, possibly corrected for late night
;; workers.
(org-today)))))
(setq p (point)))
(`(node ,title-or-id)
;; first try to get ID, then try to get title/alias
(let ((node (or (org-roam-node-from-id title-or-id)
(org-roam-node-from-title-or-alias title-or-id)
(user-error "No node with title or id \"%s\"" title-or-id))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(setq p (org-roam-node-point node)
target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))))
;; Setup `org-id' for the current capture target and return it back to the
;; caller.
;; Unless it's an entry type, then we want to create an ID for the entry instead
(pcase (org-capture-get :type)
('entry
(advice-add #'org-capture-place-entry :after #'org-roam-capture--create-id-for-entry)
(org-roam-capture--put :new-node-p t)
(setq id (org-roam-node-id org-roam-capture--node)))
(_
(save-excursion
(goto-char p)
(unless (org-entry-get p "ID")
(org-roam-capture--put :new-node-p t))
(setq id (or (org-entry-get p "ID")
(org-roam-node-id org-roam-capture--node)))
(setf (org-roam-node-id org-roam-capture--node) id)
(org-entry-put p "ID" id))))
(org-roam-capture--put :id id)
(org-roam-capture--put :target-entry-p target-entry-p)
(advice-add #'org-capture-place-template :before #'org-roam-capture--set-target-entry-p-a)
(advice-add #'org-capture-place-template :after #'org-roam-capture-run-new-node-hook-a)))
(defun org-roam-capture--set-target-entry-p-a (_)
"Correct `:target-entry-p' in Org-capture template based on `:target.'."
(org-capture-put :target-entry-p (org-roam-capture--get :target-entry-p))
(advice-remove #'org-capture-place-template #'org-roam-capture--set-target-entry-p-a))
(defun org-roam-capture-run-new-node-hook-a (_)
"Advice to run after the Org-capture template is placed."
(when (org-roam-capture--get :new-node-p)
(run-hooks 'org-roam-capture-new-node-hook))
(advice-remove #'org-capture-place-template #'org-roam-capture-run-new-node-hook-a))
(defun org-roam-capture--create-id-for-entry ()
"Create the ID for the new entry."
(org-entry-put (point) "ID" (org-roam-capture--get :id))
(advice-remove #'org-capture-place-entry #'org-roam-capture--create-id-for-entry))
(defun org-roam-capture--get-target ()
"Get the current capture :target for the capture template in use."
(or (org-roam-capture--get :target)
(user-error "Template needs to specify `:target'")))
(defun org-roam-capture--target-truepath (path)
"From PATH get the correct path to the current capture target and return it.
PATH is a string that can optionally contain templated text in
it."
(or (org-roam-node-file org-roam-capture--node)
(thread-first
path
(org-roam-capture--fill-template)
(string-trim)
(expand-file-name org-roam-directory))))
(defun org-roam-capture--new-file-p (path)
"Return t if PATH is for a new file with no visiting buffer."
(not (or (file-exists-p path)
(org-find-base-buffer-visiting path))))
(defun org-roam-capture-find-or-create-olp (olp)
"Return a marker pointing to the entry at OLP in the current buffer.
If OLP does not exist, create it. If anything goes wrong, throw
an error, and if you need to do something based on this error,
you can catch it with `condition-case'."
(let* ((level 1)
(lmin 1)
(lmax 1)
(start (point-min))
(end (point-max))
found flevel)
(unless (derived-mode-p 'org-mode)
(error "Buffer %s needs to be in Org mode" (current-buffer)))
(org-with-wide-buffer
(goto-char start)
(dolist (heading olp)
(setq heading (org-roam-capture--fill-template heading))
(let ((re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(cnt 0))
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(when (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) flevel level cnt (1+ cnt))))
(when (> cnt 1)
(error "Heading not unique on level %d: %s" lmax heading))
(when (= cnt 0)
;; Create heading if it doesn't exist
(goto-char end)
(unless (bolp) (newline))
(let (org-insert-heading-respect-content)
(org-insert-heading nil nil t))
(unless (= lmax 1)
(dotimes (_ level) (org-do-demote)))
(insert heading)
(setq end (point))
(goto-char start)
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(when (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) flevel level cnt (1+ cnt))))))
(goto-char found)
(setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq start found
end (save-excursion (org-end-of-subtree t t))))
(point-marker))))
(defun org-roam-capture--adjust-point-for-capture-type (&optional pos)
"Reposition the point for template insertion dependently on the capture type.
Return the newly adjusted position of `point'.
POS is the current position of point (an integer) inside the
currently active capture buffer, where the adjustment should
start to begin from. If it's nil, then it will default to
the current value of `point'."
(goto-char (or pos (point)))
(pcase (org-capture-get :type)
(`plain
(if (org-capture-get :prepend)
(let ((el (org-element-at-point)))
(while (and (not (eobp))
(memq (org-element-type el)
'(drawer property-drawer keyword comment comment-block horizontal-rule)))
(goto-char (org-element-property :end el))
(setq el (org-element-at-point))))
(goto-char (org-entry-end-position)))))
(point))
;;; Capture implementation
(add-hook 'org-roam-capture-preface-hook #'org-roam-capture--try-capture-to-ref-h)
(defun org-roam-capture--try-capture-to-ref-h ()
"Try to capture to an existing node that match the ref."
(when-let* ((node (and (plist-get org-roam-capture--info :ref)
(org-roam-node-from-ref
(plist-get org-roam-capture--info :ref)))))
(set-buffer (org-capture-target-buffer (org-roam-node-file node)))
(goto-char (org-roam-node-point node))
(widen)
(org-roam-node-id node)))
(add-hook 'org-roam-capture-new-node-hook #'org-roam-capture--insert-captured-ref-h)
(defun org-roam-capture--insert-captured-ref-h ()
"Insert the ref if any."
(when-let* ((ref (plist-get org-roam-capture--info :ref)))
(org-roam-ref-add ref)))
;;;; Finalizers
(add-hook 'org-capture-prepare-finalize-hook #'org-roam-capture--install-finalize-h)
(defun org-roam-capture--install-finalize-h ()
"Install `org-roam-capture--finalize' if the capture is an Org-roam capture."
(when (org-roam-capture-p)
(add-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize)))
(defun org-roam-capture--finalize ()
"Finalize the `org-roam-capture' process."
(if org-note-abort
(when-let* ((new-file (org-roam-capture--get :new-file))
(_ (yes-or-no-p "Delete file for aborted capture?")))
(when (find-buffer-visiting new-file)
(kill-buffer (find-buffer-visiting new-file)))
(delete-file new-file))
(when-let* ((buffer (plist-get org-capture-plist :buffer))
(file (buffer-file-name buffer)))
(org-id-add-location (org-roam-capture--get :id) file))
(when-let* ((finalize (org-roam-capture--get :finalize))
(org-roam-finalize-fn (intern (concat "org-roam-capture--finalize-"
(symbol-name finalize)))))
(if (functionp org-roam-finalize-fn)
(funcall org-roam-finalize-fn)
(funcall finalize))))
(remove-hook 'org-capture-after-finalize-hook #'org-roam-capture--finalize))
(defun org-roam-capture--finalize-find-file ()
"Visit the buffer after Org-capture is done.
This function is to be called in the Org-capture finalization process.
ID is unused."
(switch-to-buffer (org-capture-get :buffer)))
(defun org-roam-capture--finalize-insert-link ()
"Insert a link to ID into the buffer where Org-capture was called.
ID is the Org id of the newly captured content.
This function is to be called in the Org-capture finalization process."
(when-let* ((mkr (org-roam-capture--get :call-location))
(buf (marker-buffer mkr)))
(with-current-buffer buf
(when-let* ((region (org-roam-capture--get :region)))
(delete-region (car region) (cdr region))
(set-marker (car region) nil)
(set-marker (cdr region) nil))
(let* ((id (org-roam-capture--get :id))
(description (org-roam-capture--get :link-description))
(link (org-link-make-string (concat "id:" id)
description)))
(if (eq (point) (marker-position mkr))
(insert link)
(org-with-point-at mkr
(insert link)))
(run-hook-with-args 'org-roam-post-node-insert-hook
id
description)))))
;;;; Processing of the capture templates
(defun org-roam-capture--fill-template (template &optional ensure-newline)
"Expand TEMPLATE and return it.
It expands ${var} occurrences in TEMPLATE, and then runs
org-capture's template expansion.
When ENSURE-NEWLINE, always ensure there's a newline behind."
(let* ((template (if (functionp template)
(funcall template)
template))
(template-whitespace-content (org-roam-whitespace-content template)))
(setq template
(org-roam-format-template
template
(lambda (key default-val)
(let ((fn (intern key))
(node-fn (intern (concat "org-roam-node-" key)))
(ksym (intern (concat ":" key))))
(cond
((fboundp fn)
(funcall fn org-roam-capture--node))
((fboundp node-fn)
(funcall node-fn org-roam-capture--node))
((plist-get org-roam-capture--info ksym)
(plist-get org-roam-capture--info ksym))
(t (let ((r (read-from-minibuffer (format "%s: " key) default-val)))
(plist-put org-roam-capture--info ksym r)
r)))))))
;; WARNING:
;; `org-capture-fill-template' fills the template, but post-processes whitespace such that the resultant
;; template does not start with any whitespace, and only ends with a single newline
;;
;; Instead, we restore the whitespace in the original template.
(setq template (replace-regexp-in-string "[\n]*\\'" "" (org-capture-fill-template template)))
(when (and ensure-newline
(string-equal template-whitespace-content ""))
(setq template-whitespace-content "\n"))
(setq template (concat template template-whitespace-content))
template))
(defun org-roam-capture--convert-template (template &optional props)
"Convert TEMPLATE from Org-roam syntax to `org-capture-templates' syntax.
PROPS is a plist containing additional Org-roam specific
properties to be added to the template."
(pcase template
(`(,_key ,_desc)
template)
((or `(,key ,desc ,type ignore ,body . ,rest)
`(,key ,desc ,type (function ignore) ,body . ,rest)
`(,key ,desc ,type ,body . ,rest))
(setq rest (append rest props))
(let (org-roam-plist options)
(while rest
(let* ((key (pop rest))
(val (pop rest))
(custom (member key org-roam-capture--template-keywords)))
(when (and custom
(not val))
(user-error "Invalid capture template format: %s\nkey %s cannot be nil" template key))
(if custom
(setq org-roam-plist (plist-put org-roam-plist key val))
(setq options (plist-put options key val)))))
(append `(,key ,desc ,type #'org-roam-capture--prepare-buffer ,body)
options
(list :org-roam org-roam-plist))))
(_
(signal 'invalid-template template))))
(provide 'org-roam-capture)
;;; org-roam-capture.el ends here

Binary file not shown.

View File

@@ -0,0 +1,255 @@
;;; org-roam-compat.el --- Backward compatibility code -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This file is dedicated to maintain backward compatibility with older older
;; Emacsen and Org-roam versions.
;;
;;; Code:
(require 'org-roam)
;;; Backports
;; REVIEW Remove when 26.x support is dropped. This is exact the same as
;; `directory-files-recursively' from Emacs 26, but with FOLLOW-SYMLINKS
;; parameter from Emacs 27.
(defun org-roam--directory-files-recursively (dir regexp
&optional include-directories predicate
follow-symlinks)
"Return list of all files under directory DIR whose names match REGEXP.
This function works recursively. Files are returned in \"depth
first\" order, and files from each directory are sorted in
alphabetical order. Each file name appears in the returned list
in its absolute form.
By default, the returned list excludes directories, but if
optional argument INCLUDE-DIRECTORIES is non-nil, they are
included.
PREDICATE can be either nil (which means that all subdirectories
of DIR are descended into), t (which means that subdirectories that
can't be read are ignored), or a function (which is called with
the name of each subdirectory, and should return non-nil if the
subdirectory is to be descended into).
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
directories are followed. Note that this can lead to infinite
recursion."
(let* ((result nil)
(files nil)
(dir (directory-file-name dir))
;; When DIR is "/", remote file names like "/method:" could
;; also be offered. We shall suppress them.
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
(dolist (file (sort (file-name-all-completions "" dir)
'string<))
(unless (member file '("./" "../"))
(if (directory-name-p file)
(let* ((leaf (substring file 0 (1- (length file))))
(full-file (concat dir "/" leaf)))
;; Don't follow symlinks to other directories.
(when (and (or (not (file-symlink-p full-file))
(and (file-symlink-p full-file)
follow-symlinks))
;; Allow filtering subdirectories.
(or (eq predicate nil)
(eq predicate t)
(funcall predicate full-file)))
(let ((sub-files
(if (eq predicate t)
(condition-case nil
(org-roam--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks)
(file-error nil))
(org-roam--directory-files-recursively
full-file regexp include-directories
predicate follow-symlinks))))
(setq result (nconc result sub-files))))
(when (and include-directories
(string-match regexp leaf))
(setq result (nconc result (list full-file)))))
(when (string-match regexp file)
(push (concat dir "/" file) files)))))
(nconc result (nreverse files))))
;;; Compatibility hacks and patches
(advice-add #'org-id-add-location :around #'org-roam--handle-absent-org-id-locations-file-a)
(defun org-roam--handle-absent-org-id-locations-file-a (fn &rest args)
"Gracefully handle errors related to absence of `org-id-locations-file'.
FN is `org-id-add-location' that comes from advice and ARGS are
passed to it."
(condition-case err
(apply fn args)
;; `org-id' makes the assumption that `org-id-locations-file' will be stored in `user-emacs-directory'
;; which always exist if you have Emacs, so it uses `with-temp-file' to write to the file. However, the
;; users *do* change the path to this file and `with-temp-file' unable to create the file, if the path to
;; it consists of directories that don't exist. We'll have to handle this ourselves.
(error
(advice-remove 'org-id-add-location #'org-roam--handle-absent-org-id-locations-file-a)
(if (file-exists-p (file-truename org-id-locations-file))
(signal (car err) (cdr err))
;; Pre-allocate the hash table to avoid weird access related errors during the regeneration.
(or org-id-locations (setq org-id-locations (make-hash-table :test 'equal)))
;; If permissions allow that, try to create the user specified directory path to
;; `org-id-locations-file' ourselves.
(condition-case _err
(progn (org-roam-message (concat "`org-id-locations-file' (%s) doesn't exist. "
"Trying to regenerate it (this may take a while)...")
org-id-locations-file)
(make-directory (file-name-directory (file-truename org-id-locations-file)))
(org-roam-update-org-id-locations)
(apply fn args))
;; In case of failure (lack of permissions), we'll patch it to at least handle the current session
;; without errors.
(file-error (org-roam-message "Failed to regenerate `org-id-locations-file'")
(lwarn 'org-roam :error "
--------
WARNING: `org-id-locations-file' (%s) doesn't exist!
Org-roam is unable to create it for you.
--------
This happens when Emacs doesn't have permissions to create the
path to your `org-id-locations-file'. Org-roam will now fallback
storing the file in your current `org-roam-directory', but the
warning will keep popup with each new session.
To stop this warning from popping up, set `org-id-locations-file'
to the location you want and ensure that the path exists on your
filesystem, then run M-x `org-roam-update-org-id-locations'.
Note: While Org-roam doesn't depend on `org-id-locations-file' to
lookup IDs for the nodes that are stored in the database, it
still tries to keep it updated so IDs work across other files in
Org-mode, so the IDs used in your `org-roam-directory' would be
able to cross-reference outside of `org-roam-directory'. It also
allows to keep linking with \"id:\" links within the current
`org-roam-directory' to headings and files that are excluded from
identification (e.g. with \"ROAM_EXCLUDE\" property) as Org-roam
nodes." org-id-locations-file)
(setq org-id-locations-file
(expand-file-name ".orgids" (file-truename org-roam-directory)))
(apply fn args)))))))
;;;; Deprecated :if-new capture template keyword
(with-eval-after-load 'org-roam-capture
(add-to-list 'org-roam-capture--template-keywords :if-new)
(let ((inhibit-warning-p t)) ; REVIEW Set this to nil close to next major release
(advice-add 'org-roam-capture--get-target :around #'org-roam-capture--get-if-new-target-a)
(defun org-roam-capture--get-if-new-target-a (fn &rest args)
"Get the current capture target using deprecated :if-new property."
(if-let* ((target (org-roam-capture--get :if-new)))
(prog1 target
(unless inhibit-warning-p
(lwarn 'org-roam-capture :warning
(mapconcat
#'identity
["`:if-new' property is deprecated in favor of `:target'."
"This warning will popup once per each session. In order to get"
"rid of it, rename all the references to the `:if-new' property"
"in your capture templates to `:target'."]
"\n"))
;; Don't irritate the user too much. Displaying the warning once per session should be enough.
(setq inhibit-warning-p t)))
(apply fn args)))))
;;; Obsolete aliases (remove after next major release)
(define-obsolete-function-alias
'org-roam-setup
'org-roam-db-autosync-enable "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-teardown
'org-roam-db-autosync-disable "org-roam 2.0")
(define-obsolete-variable-alias
'org-roam-current-node
'org-roam-buffer-current-node "org-roam 2.0")
(define-obsolete-variable-alias
'org-roam-current-directory
'org-roam-buffer-current-directory "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-buffer-render
'org-roam-buffer-render-contents "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-buffer
'org-roam-buffer-display-dedicated "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-visit-thing
'org-roam-buffer-visit-thing "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-today
'org-roam-dailies-goto-today "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-yesterday
'org-roam-dailies-goto-yesterday "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-tomorrow
'org-roam-dailies-goto-tomorrow "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-next-note
'org-roam-dailies-goto-next-note "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-previous-note
'org-roam-dailies-goto-previous-note "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-dailies-find-date
'org-roam-dailies-goto-date "org-roam 2.0")
(define-obsolete-function-alias
'org-roam-add-property
'org-roam-property-add "org-roam 2.1")
(define-obsolete-function-alias
'org-roam-remove-property
'org-roam-property-remove "org-roam 2.1")
(define-obsolete-variable-alias
'org-roam-mode-section-functions
'org-roam-mode-sections "org-roam 2.2.0")
(define-obsolete-function-alias
'org-roam-dolist-with-progress
'dolist-with-progress-reporter "2025-11-07")
;;; Obsolete functions
(make-obsolete 'org-roam-get-keyword 'org-collect-keywords "org-roam 2.0")
;;;###autoload
(defun org-roam-db-autosync-enable ()
"Activate `org-roam-db-autosync-mode'."
(declare (obsolete org-roam-db-autosync-mode "2025-11-23"))
(org-roam-db-autosync-mode +1))
(defun org-roam-db-autosync-disable ()
"Deactivate `org-roam-db-autosync-mode'."
(declare (obsolete org-roam-db-autosync-mode "2025-11-23"))
(org-roam-db-autosync-mode -1))
(defun org-roam-db-autosync-toggle ()
"Toggle `org-roam-db-autosync-mode' enabled/disabled."
(declare (obsolete org-roam-db-autosync-mode "2025-11-23"))
(org-roam-db-autosync-mode 'toggle))
(provide 'org-roam-compat)
;;; org-roam-compat.el ends here

Binary file not shown.

View File

@@ -0,0 +1,366 @@
;;; org-roam-dailies.el --- Daily-notes for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;;;
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Copyright © 2020 Leo Vivier <leo.vivier+dev@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; Leo Vivier <leo.vivier+dev@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Requires: ((emacs "26.1") (dash "2.13") (org-roam "2.1"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This extension provides functionality for creating daily-notes, or shortly
;; "dailies". Dailies implemented here as a unique node per unique file, where
;; each file named after certain date and stored in `org-roam-dailies-directory'.
;;
;; One can use dailies for various purposes, e.g. journaling, fleeting notes,
;; scratch notes or whatever else you can think of.
;;
;;; Code:
(require 'dash)
(require 'org-roam)
;;; Faces
(defface org-roam-dailies-calendar-note
'((t :inherit (org-link) :underline nil))
"Face for dates with a daily-note in the calendar."
:group 'org-roam-faces)
;;; Options
(defcustom org-roam-dailies-directory "daily/"
"Path to daily-notes.
This path is relative to `org-roam-directory'."
:group 'org-roam
:type 'string)
(defcustom org-roam-dailies-find-file-hook nil
"Hook that is run right after navigating to a daily-note."
:group 'org-roam
:type 'hook)
(defcustom org-roam-dailies-capture-templates
`(("d" "default" entry
"* %?"
:target (file+head "%<%Y-%m-%d>.org"
"#+title: %<%Y-%m-%d>\n")))
"Capture templates for daily-notes in Org-roam.
Note that for daily files to show up in the calendar, they have to be of format
\"org-time-string.org\".
See `org-roam-capture-templates' for the template documentation."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;; Commands
;;;; Today
;;;###autoload
(defun org-roam-dailies-capture-today (&optional goto keys)
"Create an entry in the daily-note for today.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "P")
(org-roam-dailies--capture (current-time) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-today (&optional keys)
"Find the daily-note for today, creating it if necessary.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive)
(org-roam-dailies-capture-today t keys))
;;;; Tomorrow
;;;###autoload
(defun org-roam-dailies-capture-tomorrow (n &optional goto keys)
"Create an entry in the daily-note for tomorrow.
With numeric argument N, use the daily-note N days in the future.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies--capture (time-add (* n 86400) (current-time)) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-tomorrow (n &optional keys)
"Find the daily-note for tomorrow, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow n t keys))
;;;; Yesterday
;;;###autoload
(defun org-roam-dailies-capture-yesterday (n &optional goto keys)
"Create an entry in the daily-note for yesteday.
With numeric argument N, use the daily-note N days in the past.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) goto keys))
;;;###autoload
(defun org-roam-dailies-goto-yesterday (n &optional keys)
"Find the daily-note for yesterday, creating it if necessary.
With numeric argument N, use the daily-note N days in the
future.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "p")
(org-roam-dailies-capture-tomorrow (- n) t keys))
;;;; Date
;;;###autoload
(defun org-roam-dailies-capture-date (&optional goto prefer-future keys)
"Create an entry in the daily-note for a date using the calendar.
Prefer past dates, unless PREFER-FUTURE is non-nil.
With a `C-u' prefix or when GOTO is non-nil, go the note without
creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive "P")
(let ((time (let ((org-read-date-prefer-future prefer-future))
(org-read-date nil t nil (if goto
"Find daily-note: "
"Capture to daily-note: ")))))
(org-roam-dailies--capture time goto keys)))
;;;###autoload
(defun org-roam-dailies-goto-date (&optional prefer-future keys)
"Find the daily-note for a date using the calendar, creating it if necessary.
Prefer past dates, unless PREFER-FUTURE is non-nil.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(interactive)
(org-roam-dailies-capture-date t prefer-future keys))
;;;; Navigation
(defun org-roam-dailies-goto-next-note (&optional n)
"Find next daily-note.
With numeric argument N, find note N days in the future. If N is
negative, find note N days in the past."
(interactive "p")
(unless (org-roam-dailies--daily-note-p)
(user-error "Not in a daily-note"))
(setq n (or n 1))
(let* ((dailies (org-roam-dailies--list-files))
(position
(cl-position-if (lambda (candidate)
(string= (buffer-file-name (buffer-base-buffer)) candidate))
dailies))
note)
(unless position
(user-error "Can't find current note file - have you saved it yet?"))
(pcase n
((pred (natnump))
(when (eq position (- (length dailies) 1))
(user-error "Already at newest note")))
((pred (integerp))
(when (eq position 0)
(user-error "Already at oldest note"))))
(setq note (nth (+ position n) dailies))
(find-file note)
(run-hooks 'org-roam-dailies-find-file-hook)))
(defun org-roam-dailies-goto-previous-note (&optional n)
"Find previous daily-note.
With numeric argument N, find note N days in the past. If N is
negative, find note N days in the future."
(interactive "p")
(let ((n (if n (- n) -1)))
(org-roam-dailies-goto-next-note n)))
(defun org-roam-dailies--list-files (&rest extra-files)
"List all files in `org-roam-dailies-directory'.
EXTRA-FILES can be used to append extra files to the list."
(let ((dir (expand-file-name org-roam-dailies-directory org-roam-directory))
(regexp (rx-to-string `(and "." (or ,@org-roam-file-extensions)))))
(append (--remove (let ((file (file-name-nondirectory it)))
(when (or (auto-save-file-name-p file)
(backup-file-name-p file)
(string-match "^\\." file))
it))
(directory-files-recursively dir regexp))
extra-files)))
(defun org-roam-dailies--daily-note-p (&optional file)
"Return t if FILE is an Org-roam daily-note, nil otherwise.
If FILE is not specified, use the current buffer's file-path."
(when-let* ((path (expand-file-name
(or file
(buffer-file-name (buffer-base-buffer)))))
(directory (expand-file-name org-roam-dailies-directory org-roam-directory)))
(setq path (expand-file-name path))
(save-match-data
(and
(org-roam-file-p path)
(org-roam-descendant-of-p path directory)))))
;;;###autoload
(defun org-roam-dailies-find-directory ()
"Find and open `org-roam-dailies-directory'."
(interactive)
(find-file (expand-file-name org-roam-dailies-directory org-roam-directory)))
;;; Calendar integration
(defun org-roam-dailies-calendar--file-to-date (file)
"Convert FILE to date.
Return (MONTH DAY YEAR) or nil if not an Org time-string."
(ignore-errors
(cl-destructuring-bind (_ _ _ d m y _ _ _)
(org-parse-time-string
(file-name-sans-extension
(file-name-nondirectory file)))
(list m d y))))
(defun org-roam-dailies-calendar-mark-entries ()
"Mark days in the calendar for which a daily-note is present."
(when (file-exists-p (expand-file-name org-roam-dailies-directory org-roam-directory))
(dolist (date (remove nil
(mapcar #'org-roam-dailies-calendar--file-to-date
(org-roam-dailies--list-files))))
(when (calendar-date-is-visible-p date)
(calendar-mark-visible-date date 'org-roam-dailies-calendar-note)))))
(add-hook 'calendar-today-visible-hook #'org-roam-dailies-calendar-mark-entries)
(add-hook 'calendar-today-invisible-hook #'org-roam-dailies-calendar-mark-entries)
;;; Capture implementation
(add-to-list 'org-roam-capture--template-keywords :override-default-time)
(defun org-roam-dailies--capture (time &optional goto keys)
"Capture an entry in a daily-note for TIME, creating it if necessary.
When GOTO is non-nil, go the note without creating an entry.
ELisp programs can set KEYS to a string associated with a template.
In this case, interactive selection will be bypassed."
(let ((org-roam-directory (expand-file-name org-roam-dailies-directory org-roam-directory))
(org-roam-dailies-directory "./"))
(org-roam-capture- :goto (when goto '(4))
:keys keys
:node (org-roam-node-create)
:templates org-roam-dailies-capture-templates
:props (list :override-default-time time)))
(when goto (run-hooks 'org-roam-dailies-find-file-hook)))
(add-hook 'org-roam-capture-preface-hook #'org-roam-dailies--override-capture-time-h)
(defun org-roam-dailies--override-capture-time-h ()
"Override the `:default-time' with the time from `:override-default-time'."
(when (org-roam-capture--get :override-default-time)
(org-capture-put :default-time (org-roam-capture--get :override-default-time)))
nil)
;;; Bindings
(defvar org-roam-dailies-map (make-sparse-keymap)
"Keymap for `org-roam-dailies'.")
(define-prefix-command 'org-roam-dailies-map)
(define-key org-roam-dailies-map (kbd "d") #'org-roam-dailies-goto-today)
(define-key org-roam-dailies-map (kbd "y") #'org-roam-dailies-goto-yesterday)
(define-key org-roam-dailies-map (kbd "t") #'org-roam-dailies-goto-tomorrow)
(define-key org-roam-dailies-map (kbd "n") #'org-roam-dailies-capture-today)
(define-key org-roam-dailies-map (kbd "f") #'org-roam-dailies-goto-next-note)
(define-key org-roam-dailies-map (kbd "b") #'org-roam-dailies-goto-previous-note)
(define-key org-roam-dailies-map (kbd "c") #'org-roam-dailies-goto-date)
(define-key org-roam-dailies-map (kbd "v") #'org-roam-dailies-capture-date)
(define-key org-roam-dailies-map (kbd ".") #'org-roam-dailies-find-directory)
(provide 'org-roam-dailies)
;;; org-roam-dailies.el ends here

Binary file not shown.

View File

@@ -0,0 +1,730 @@
;;; org-roam-db.el --- Org-roam database API -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This module provides the underlying database API to Org-roam.
;;
;;; Code:
(require 'org-roam)
(require 'url-parse)
(require 'ol)
(defvar org-outline-path-cache)
;;; Options
(defcustom org-roam-db-location (locate-user-emacs-file "org-roam.db")
"The path to file where the Org-roam database is stored.
It is the user's responsibility to set this correctly, especially
when used with multiple Org-roam instances."
:type 'string
:group 'org-roam)
(defcustom org-roam-db-gc-threshold gc-cons-threshold
"The value to temporarily set the `gc-cons-threshold' threshold to.
During `org-roam-db-sync', Emacs can pause multiple times to
perform garbage collection because of the large number of
temporary structures generated (e.g. parsed ASTs).
`gc-cons-threshold' is temporarily set to
`org-roam-db-gc-threshold' during this operation, and increasing
`gc-cons-threshold' will help reduce the number of GC operations,
at the cost of memory usage. Tweaking this value may lead to
better overall performance.
For example, to reduce the number of GCs to the minimum, on
machines with large memory one may set it to
`most-positive-fixnum'."
:type 'int
:group 'org-roam)
(defcustom org-roam-db-node-include-function (lambda () t)
"A custom function to check if the point contains a valid node.
This function is called each time a node (both file and headline)
is about to be saved into the Org-roam database.
If the function returns nil, Org-roam will skip the node. This
function is useful for excluding certain nodes from the Org-roam
database."
:type 'function
:group 'org-roam)
(defcustom org-roam-db-update-on-save t
"If t, update the Org-roam database upon saving the file.
Disable this if your files are large and updating the database is
slow."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-db-extra-links-elements '(node-property keyword)
"The list of Org element types to include for parsing by Org-roam.
By default, when parsing Org's AST, links within keywords and
property drawers are not parsed as links. Sometimes however, it
is desirable to parse and cache these links (e.g. hiding links in
a property drawer)."
:package-version '(org-roam . "2.2.0")
:group 'org-roam
:type '(set
(const :tag "keywords" keyword)
(const :tag "property drawers" node-property)))
(defcustom org-roam-db-extra-links-exclude-keys '((node-property . ("ROAM_REFS"))
(keyword . ("transclude")))
"Keys to ignore when mapping over links.
The car of the association list is the Org element type (e.g.
keyword). The cdr is a list of case-insensitive strings to
exclude from being treated as links.
For example, we use this to prevent self-referential links in
ROAM_REFS."
:package-version '(org-roam . "2.2.0")
:group 'org-roam
:type '(alist))
;;; Variables
(defconst org-roam-db-version 20)
(defvar org-roam-db--connection (make-hash-table :test #'equal)
"Database connection to Org-roam database.")
;;; Core Functions
(defun org-roam-db--get-connection ()
"Return the database connection, if any."
(gethash (expand-file-name (file-name-as-directory org-roam-directory))
org-roam-db--connection))
(defun org-roam-db ()
"Entrypoint to the Org-roam sqlite database.
Initializes and stores the database, and the database connection.
Performs a database upgrade when required."
(unless (and (org-roam-db--get-connection)
(emacsql-live-p (org-roam-db--get-connection)))
(let ((init-db (not (file-exists-p org-roam-db-location))))
(make-directory (file-name-directory org-roam-db-location) t)
(let ((conn (emacsql-sqlite-open org-roam-db-location)))
(puthash (expand-file-name (file-name-as-directory org-roam-directory))
conn
org-roam-db--connection)
(when init-db
(org-roam-db--init conn))
(let* ((version (caar (emacsql conn "PRAGMA user_version")))
(version (org-roam-db--upgrade-maybe conn version)))
(cond
((> version org-roam-db-version)
(emacsql-close conn)
(user-error
"The Org-roam database was created with a newer Org-roam version. %s"
"You need to update the Org-roam package"))
((< version org-roam-db-version)
(emacsql-close conn)
(error "BUG: The Org-roam database scheme changed %s"
"and there is no upgrade path")))))))
(org-roam-db--get-connection))
;;; Entrypoint: (org-roam-db-query)
(define-error 'emacsql-constraint "SQL constraint violation")
(defun org-roam-db-query (sql &rest args)
"Run SQL query on Org-roam database with ARGS.
SQL can be either the emacsql vector representation, or a string."
(apply #'emacsql (org-roam-db) sql args))
(defun org-roam-db-query! (handler sql &rest args)
"Run SQL query on Org-roam database with ARGS.
SQL can be either the emacsql vector representation, or a string.
The query is expected to be able to fail, in this situation, run HANDLER."
(condition-case err
(org-roam-db-query sql args)
(emacsql-constraint
(funcall handler err))))
;;; Schemata
(defconst org-roam-db--table-schemata
'((files
[(file :unique :primary-key)
title
(hash :not-null)
(atime :not-null)
(mtime :not-null)])
(nodes
([(id :not-null :primary-key)
(file :not-null)
(level :not-null)
(pos :not-null)
todo
priority
(scheduled text)
(deadline text)
title
properties
olp]
(:foreign-key [file] :references files [file] :on-delete :cascade)))
(aliases
([(node-id :not-null)
alias]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(citations
([(node-id :not-null)
(cite-key :not-null)
(pos :not-null)
properties]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(refs
([(node-id :not-null)
(ref :not-null)
(type :not-null)]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(tags
([(node-id :not-null)
tag]
(:foreign-key [node-id] :references nodes [id] :on-delete :cascade)))
(links
([(pos :not-null)
(source :not-null)
(dest :not-null)
(type :not-null)
(properties :not-null)]
(:foreign-key [source] :references nodes [id] :on-delete :cascade)))))
(defconst org-roam-db--table-indices
'((alias-node-id aliases [node-id])
(refs-node-id refs [node-id])
(tags-node-id tags [node-id])))
(defun org-roam-db--init (db)
"Initialize database DB with the correct schema and user version."
(emacsql-with-transaction db
(pcase-dolist (`(,table ,schema) org-roam-db--table-schemata)
(emacsql db [:create-table $i1 $S2] table schema))
(pcase-dolist (`(,index-name ,table ,columns) org-roam-db--table-indices)
(emacsql db [:create-index $i1 :on $i2 $S3] index-name table columns))
(emacsql db (format "PRAGMA user_version = %s" org-roam-db-version))))
(defun org-roam-db--upgrade-maybe (db version)
"Upgrades the database schema for DB, if VERSION is old."
(emacsql-with-transaction db
'ignore
(if (< version org-roam-db-version)
(progn
(org-roam-message (format "Upgrading the Org-roam database from version %d to version %d"
version org-roam-db-version))
(org-roam-db-sync t))))
version)
(defun org-roam-db--close (&optional db)
"Closes the database connection for database DB.
If DB is nil, closes the database connection for the database in
the current `org-roam-directory'."
(unless db
(setq db (org-roam-db--get-connection)))
(when (and db (emacsql-live-p db))
(emacsql-close db)))
(defun org-roam-db--close-all ()
"Closes all database connections made by Org-roam."
(dolist (conn (hash-table-values org-roam-db--connection))
(org-roam-db--close conn)))
;;; Database API
;;;; Clearing
(defun org-roam-db-clear-all ()
"Clears all entries in the Org-roam cache."
(interactive)
(when (file-exists-p org-roam-db-location)
(dolist (table (mapcar #'car org-roam-db--table-schemata))
(org-roam-db-query `[:delete :from ,table]))))
(defun org-roam-db-clear-file (&optional file)
"Remove any related links to the FILE.
This is equivalent to removing the node from the graph.
If FILE is nil, clear the current buffer."
(setq file (or file (buffer-file-name (buffer-base-buffer))))
(org-roam-db-query [:delete :from files
:where (= file $s1)]
file))
;;;; Updating tables
(defun org-roam-db--file-title ()
"In current Org buffer, get the title.
If there is no title, return the file name relative to
`org-roam-directory'."
(org-link-display-format
(or (string-join (cdr (assoc "TITLE" (org-collect-keywords '("title")))) " ")
(file-name-sans-extension (file-relative-name
(buffer-file-name (buffer-base-buffer))
org-roam-directory)))))
(defun org-roam-db-insert-file (&optional hash)
"Update the files table for the current buffer.
If UPDATE-P is non-nil, first remove the file in the database.
If HASH is non-nil, use that as the file's hash without recalculating it."
(let* ((file (buffer-file-name))
(file-title (org-roam-db--file-title))
(attr (file-attributes file))
(atime (file-attribute-access-time attr))
(mtime (file-attribute-modification-time attr))
(hash (or hash (org-roam-db--file-hash file))))
(org-roam-db-query
[:insert :into files
:values $v1]
(list (vector file file-title hash atime mtime)))))
(defun org-roam-db-get-scheduled-time ()
"Return the scheduled time at point in ISO8601 format."
(when-let* ((time (org-get-scheduled-time (point))))
(format-time-string "%FT%T" time)))
(defun org-roam-db-get-deadline-time ()
"Return the deadline time at point in ISO8601 format."
(when-let* ((time (org-get-deadline-time (point))))
(format-time-string "%FT%T" time)))
(defun org-roam-db-node-p ()
"Return t if headline at point is an Org-roam node, else return nil."
(and (org-id-get)
(not (org-entry-get (point) "ROAM_EXCLUDE"))
(funcall org-roam-db-node-include-function)))
(defun org-roam-db-map-nodes (fns)
"Run FNS over all nodes in the current buffer."
(org-with-wide-buffer
(org-map-region
(lambda ()
(when (org-roam-db-node-p)
(dolist (fn fns)
(funcall fn))))
(point-min) (point-max))))
(defun org-roam-db-map-links (fns)
"Run FNS over all links in the current buffer."
(org-with-point-at 1
(while (re-search-forward org-link-any-re nil :no-error)
;; `re-search-forward' let the cursor one character after the link, we need to go backward one char to
;; make the point be on the link.
(backward-char)
(let* ((begin (match-beginning 0))
(element (org-element-context))
(type (org-element-type element))
link)
(cond
;; Links correctly recognized by Org Mode
((eq type 'link)
(setq link element))
;; Links in property drawers and lines starting with #+. Recall that, as for Org Mode v9.4.4, the
;; org-element-type of links within properties drawers is "node-property" and for lines starting with
;; #+ is "keyword".
((and (member type org-roam-db-extra-links-elements)
(not (member-ignore-case (org-element-property :key element)
(cdr (assoc type org-roam-db-extra-links-exclude-keys))))
(setq link (save-excursion
(goto-char begin)
(save-match-data (org-element-link-parser)))))))
(when link
(dolist (fn fns)
(funcall fn link)))))))
(defun org-roam-db-map-citations (info fns)
"Run FNS over all citations in the current buffer.
INFO is the org-element parsed buffer."
(org-element-map info 'citation-reference
(lambda (cite)
(dolist (fn fns)
(funcall fn cite)))))
(defun org-roam-db-insert-file-node ()
"Insert the file-level node into the Org-roam cache."
(org-with-point-at 1
(when (and (= (org-outline-level) 0)
(org-roam-db-node-p))
(when-let* ((id (org-id-get)))
(let* ((file (buffer-file-name (buffer-base-buffer)))
(title (org-roam-db--file-title))
(pos (point))
(todo nil)
(priority nil)
(scheduled nil)
(deadline nil)
(level 0)
(tags org-file-tags)
(properties (org-entry-properties))
(olp nil))
(org-roam-db-query!
(lambda (err)
(lwarn 'org-roam :warning "%s for %s (%s) in %s"
(error-message-string err)
title id file))
[:insert :into nodes
:values $v1]
(vector id file level pos todo priority
scheduled deadline title properties olp))
(when tags
(org-roam-db-query
[:insert :into tags
:values $v1]
(mapcar (lambda (tag)
(vector id (substring-no-properties tag)))
tags)))
(org-roam-db-insert-aliases)
(org-roam-db-insert-refs))))))
(cl-defun org-roam-db-insert-node-data ()
"Insert node data for headline at point into the Org-roam cache."
(when-let* ((id (org-id-get)))
(let* ((file (buffer-file-name (buffer-base-buffer)))
(heading-components (org-heading-components))
(pos (point))
(todo (nth 2 heading-components))
(priority (nth 3 heading-components))
(level (nth 1 heading-components))
(scheduled (org-roam-db-get-scheduled-time))
(deadline (org-roam-db-get-deadline-time))
(title (or (nth 4 heading-components)
(progn (lwarn 'org-roam :warning "Node in %s:%s:%s has no title, skipping..."
file
(line-number-at-pos)
(1+ (- (point) (line-beginning-position))))
(cl-return-from org-roam-db-insert-node-data))))
(properties (org-entry-properties))
(olp (org-get-outline-path nil 'use-cache))
(title (org-link-display-format title)))
(org-roam-db-query!
(lambda (err)
(lwarn 'org-roam :warning "%s for %s (%s) in %s"
(error-message-string err)
title id file))
[:insert :into nodes
:values $v1]
(vector id file level pos todo priority
scheduled deadline title properties olp)))))
(defun org-roam-db-insert-aliases ()
"Insert aliases for node at point into Org-roam cache."
(when-let* ((node-id (org-id-get))
(aliases (org-entry-get (point) "ROAM_ALIASES"))
(aliases (split-string-and-unquote aliases)))
(org-roam-db-query [:insert :into aliases
:values $v1]
(mapcar (lambda (alias)
(vector node-id alias))
aliases))))
(defun org-roam-db-insert-tags ()
"Insert tags for node at point into Org-roam cache."
(when-let* ((node-id (org-id-get))
(tags (org-get-tags)))
(org-roam-db-query [:insert :into tags
:values $v1]
(mapcar (lambda (tag)
(vector node-id (substring-no-properties tag))) tags))))
(defun org-roam-db-insert-refs ()
"Insert refs for node at point into Org-roam cache."
(when-let* ((node-id (org-id-get))
(refs (org-entry-get (point) "ROAM_REFS"))
(refs (split-string-and-unquote refs)))
(let (rows)
(dolist (ref refs)
(save-match-data
(cond (;; @citeKey
(string-prefix-p "@" ref)
(push (vector node-id (substring ref 1) "cite") rows))
(;; [cite:@citeKey]
(string-prefix-p "[cite:" ref)
(condition-case nil
(let ((cite-obj (org-cite-parse-objects ref)))
(org-element-map cite-obj 'citation-reference
(lambda (cite)
(let ((key (org-element-property :key cite)))
(push (vector node-id key "cite") rows)))))
(error
(lwarn '(org-roam) :warning
"%s:%s\tInvalid cite %s, skipping..." (buffer-file-name) (point) ref))))
(;; https://google.com, cite:citeKey
;; Note: we use string-match here because it matches any link: e.g. [[cite:abc][abc]]
;; But this form of matching is loose, and can accept invalid links e.g. [[cite:abc]
(string-match org-link-any-re (org-link-encode ref '(#x20)))
(setq ref (org-link-encode ref '(#x20)))
(let ((ref-url (url-generic-parse-url (or (match-string 2 ref) (match-string 0 ref))))
(link-type ()) ;; clear url-type for backward compatible.
(path ()))
(setq link-type (url-type ref-url))
(setf (url-type ref-url) nil)
(setq path (org-link-decode (url-recreate-url ref-url)))
(if (and (boundp 'org-ref-cite-types)
(or (assoc link-type org-ref-cite-types)
(member link-type org-ref-cite-types)))
(dolist (key (org-roam-org-ref-path-to-keys path))
(push (vector node-id key link-type) rows))
(push (vector node-id path link-type) rows))))
(t
(lwarn '(org-roam) :warning
"%s:%s\tInvalid ref %s, skipping..." (buffer-file-name) (point) ref)))))
(when rows
(org-roam-db-query [:insert :into refs
:values $v1]
rows)))))
(defun org-roam-db-insert-link (link)
"Insert link data for LINK at current point into the Org-roam cache."
(save-excursion
(goto-char (org-element-property :begin link))
(let* ((type (org-element-property :type link))
(path (org-element-property :path link))
(option (and (string-match "::\\(.*\\)\\'" path)
(match-string 1 path)))
(path (if (not option) path
(substring path 0 (match-beginning 0))))
(source (org-roam-id-at-point))
(properties (list :outline (ignore-errors
;; This can error if link is not under any headline
(org-get-outline-path 'with-self 'use-cache))))
(properties (if option (plist-put properties :search-option option)
properties)))
;; For Org-ref links, we need to split the path into the cite keys
(when (and source path)
(if (and (boundp 'org-ref-cite-types)
(or (assoc type org-ref-cite-types)
(member type org-ref-cite-types)))
(org-roam-db-query
[:insert :into citations
:values $v1]
(mapcar (lambda (k) (vector source k (point) properties))
(org-roam-org-ref-path-to-keys path)))
(org-roam-db-query
[:insert :into links
:values $v1]
(vector (point) source path type properties)))))))
(defun org-roam-db-insert-citation (citation)
"Insert data for CITATION at current point into the Org-roam cache."
(save-excursion
(goto-char (org-element-property :begin citation))
(let ((key (org-element-property :key citation))
(source (org-roam-id-at-point))
(properties (list :outline (ignore-errors
;; This can error if link is not under any headline
(org-get-outline-path 'with-self 'use-cache)))))
(when (and source key)
(org-roam-db-query
[:insert :into citations
:values $v1]
(vector source key (point) properties))))))
;;;; Fetching
(defun org-roam-db--get-current-files ()
"Return a hash-table of file to the hash of its file contents."
(let ((current-files (org-roam-db-query [:select [file hash] :from files]))
(ht (make-hash-table :test #'equal)))
(dolist (row current-files)
(puthash (car row) (cadr row) ht))
ht))
(defun org-roam-db--file-hash (file-path)
"Compute the hash of FILE-PATH."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file-path)
(secure-hash 'sha1 (current-buffer))))
;;;; Synchronization
(defun org-roam-db-update-file (&optional file-path _deprecated-arg)
"Update Org-roam cache for FILE-PATH.
If the file does not exist anymore, remove it from the cache.
If the file exists, update the cache with information.
If NO-REQUIRE, don't require optional libraries. Set NO-REQUIRE
when the libraries are already required at some toplevel, e.g.
in `org-roam-db-sync'."
(setq file-path (or file-path (buffer-file-name (buffer-base-buffer))))
(let ((content-hash (org-roam-db--file-hash file-path))
(db-hash (caar (org-roam-db-query [:select hash :from files
:where (= file $s1)] file-path)))
info)
(unless (string= content-hash db-hash)
(require 'org-ref nil t)
(org-roam-with-file file-path nil
(emacsql-with-transaction (org-roam-db)
(org-with-wide-buffer
(org-set-regexps-and-options 'tags-only)
;; Org doesn't use this anymore, so we probably should stop too.
;; (org-refresh-category-properties)
(org-roam-db-clear-file)
(org-roam-db-insert-file content-hash)
(org-roam-db-insert-file-node)
(setq org-outline-path-cache nil)
(org-roam-db-map-nodes
(list #'org-roam-db-insert-node-data
#'org-roam-db-insert-aliases
#'org-roam-db-insert-tags
#'org-roam-db-insert-refs))
(setq org-outline-path-cache nil)
(setq info (org-element-parse-buffer))
(org-roam-db-map-links
(list #'org-roam-db-insert-link))
(when (require 'oc nil t)
(org-roam-db-map-citations
info
(list #'org-roam-db-insert-citation)))))))))
;;;###autoload
(defun org-roam-db-sync (&optional force)
"Synchronize the cache state with the current Org files on-disk.
If FORCE, force a rebuild of the cache from scratch."
(interactive "P")
(org-roam-db--close) ;; Force a reconnect
(when force (delete-file org-roam-db-location))
(org-roam-db) ;; To initialize the database, no-op if already initialized
(require 'org-ref nil t)
(require 'oc nil t)
(let* ((gc-cons-threshold org-roam-db-gc-threshold)
(org-agenda-files nil)
(org-roam-files (org-roam-list-files))
(current-files (org-roam-db--get-current-files))
(modified-files nil))
(dolist (file org-roam-files)
(let ((contents-hash (org-roam-db--file-hash file)))
(unless (string= (gethash file current-files)
contents-hash)
(push file modified-files)))
(remhash file current-files))
(emacsql-with-transaction (org-roam-db)
(dolist-with-progress-reporter (file (hash-table-keys current-files))
"Clearing removed files..."
(org-roam-db-clear-file file))
(dolist-with-progress-reporter (file modified-files)
"Processing modified files..."
(condition-case err
(org-roam-db-update-file file)
(error
(org-roam-db-clear-file file)
(lwarn 'org-roam :error "Failed to process %s with error %s, skipping..."
file (error-message-string err))))))))
;;;###autoload
(define-minor-mode org-roam-db-autosync-mode
"Global minor mode to keep your Org-roam session automatically synchronized.
Through the session this will continue to setup your
buffers (that are Org-roam file visiting), keep track of the
related changes, maintain cache consistency and incrementally
update the currently active database.
If you need to manually trigger resync of the currently active
database, see `org-roam-db-sync' command."
:group 'org-roam
:global t
:init-value nil
(let ((enabled org-roam-db-autosync-mode))
(cond
(enabled
(add-hook 'find-file-hook #'org-roam-db-autosync--setup-file-h)
(add-hook 'kill-emacs-hook #'org-roam-db--close-all)
(advice-add #'rename-file :after #'org-roam-db-autosync--rename-file-a)
(advice-add #'delete-file :before #'org-roam-db-autosync--delete-file-a)
(advice-add #'vc-delete-file :around #'org-roam-db-autosync--vc-delete-file-a)
(org-roam-db-sync))
(t
(remove-hook 'find-file-hook #'org-roam-db-autosync--setup-file-h)
(remove-hook 'kill-emacs-hook #'org-roam-db--close-all)
(advice-remove #'rename-file #'org-roam-db-autosync--rename-file-a)
(advice-remove #'delete-file #'org-roam-db-autosync--delete-file-a)
(advice-remove #'vc-delete-file #'org-roam-db-autosync--vc-delete-file-a)
(org-roam-db--close-all)
;; Disable local hooks for all org-roam buffers
(dolist (buf (org-roam-buffer-list))
(with-current-buffer buf
(remove-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h t)))))))
(defun org-roam-db-autosync--delete-file-a (file &optional _trash)
"Maintain cache consistency when file deletes.
FILE is removed from the database."
(when (and (not (auto-save-file-name-p file))
(not (backup-file-name-p file))
(org-roam-file-p file))
(org-roam-db-clear-file (expand-file-name file))))
(defun org-roam-db-autosync--vc-delete-file-a (fun file)
"Maintain cache consistency on file deletion by FUN.
FILE is removed from the database."
(let ((org-roam-file-p (and (not (auto-save-file-name-p file))
(not (backup-file-name-p file))
(org-roam-file-p file))))
(apply fun `(,file))
(when (and org-roam-file-p
(not (file-exists-p file)))
(org-roam-db-clear-file (expand-file-name file)))))
(defun org-roam-db-autosync--rename-file-a (old-file new-file-or-dir &rest _args)
"Maintain cache consistency of file rename.
OLD-FILE is cleared from the database, and NEW-FILE-OR-DIR is added."
(let ((new-file (if (directory-name-p new-file-or-dir)
(expand-file-name (file-name-nondirectory old-file) new-file-or-dir)
new-file-or-dir)))
(setq new-file (expand-file-name new-file))
(setq old-file (expand-file-name old-file))
(when (and (not (auto-save-file-name-p old-file))
(not (auto-save-file-name-p new-file))
(not (backup-file-name-p old-file))
(not (backup-file-name-p new-file))
(org-roam-file-p old-file))
(org-roam-db-clear-file old-file))
(when (org-roam-file-p new-file)
(org-roam-db-update-file new-file))))
(defun org-roam-db-autosync--setup-file-h ()
"Setup the current buffer if it visits an Org-roam file."
(when (org-roam-file-p) (run-hooks 'org-roam-find-file-hook)))
(add-hook 'org-roam-find-file-hook #'org-roam-db-autosync--setup-update-on-save-h)
(defun org-roam-db-autosync--setup-update-on-save-h ()
"Setup the current buffer to update the DB after saving the current file."
(add-hook 'after-save-hook #'org-roam-db-autosync--try-update-on-save-h nil t))
(defun org-roam-db-autosync--try-update-on-save-h ()
"If appropriate, update the database for the current file after saving buffer."
(when org-roam-db-update-on-save (org-roam-db-update-file)))
;;; Diagnostics
(defun org-roam-db-diagnose-node ()
"Print information about node at point."
(interactive)
(prin1 (org-roam-node-at-point)))
(defun org-roam-db-explore ()
"Explore the org-roam DB contents."
(interactive)
(require 'sqlite-mode nil t)
(if (fboundp 'sqlite-mode-open-file)
(sqlite-mode-open-file org-roam-db-location)
(message "org-roam-db-explore: This command requires Emacs 29")))
(provide 'org-roam-db)
;;; org-roam-db.el ends here

Binary file not shown.

View File

@@ -0,0 +1,74 @@
;;; org-roam-export.el --- Org-roam org-export tweaks -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Requires: ((emacs "26.1") (org "9.6") (org-roam "2.1"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This package provides the necessary changes required to make org-export work out-of-the-box.
;;
;; To enable it, run:
;;
;; (require 'org-roam-export)
;;
;; The key issue Org's export-to-html functionality has is that it does not respect the ID property, which
;; Org-roam relies heavily on. This patches the necessary function in ox-html to export ID links correctly,
;; pointing to the correct place.
;;
;;; Code:
(require 'ox-html)
(defun org-roam-export--org-html--reference (datum info &optional named-only)
"Org-roam's patch for `org-html--reference' to support ID link export.
See `org-html--reference' for DATUM, INFO and NAMED-ONLY."
(let* ((type (org-element-type datum))
(user-label
(org-element-property
(pcase type
((or `headline `inlinetask) :CUSTOM_ID)
((or `radio-target `target) :value)
(_ :name))
datum))
(user-label
(or user-label
(when-let* ((path (org-element-property :ID datum)))
;; see `org-html-link' for why we use "ID-"
;; (search for "ID-" in ox-html.el)
(concat "ID-" path)))))
(cond
((and user-label
(or (plist-get info :html-prefer-user-labels)
(memq type '(headline inlinetask))))
user-label)
((and named-only
(not (memq type '(headline inlinetask radio-target target)))
(not user-label))
nil)
(t
(org-export-get-reference datum info)))))
(advice-add 'org-html--reference :override #'org-roam-export--org-html--reference)
(provide 'org-roam-export)
;;; org-roam-export.el ends here

Binary file not shown.

View File

@@ -0,0 +1,301 @@
;;; org-roam-graph.el --- Basic graphing functionality for Org-roam -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Requires: ((emacs "26.1") (org "9.6") (org-roam "2.1"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This extension implements capability to build and generate graphs in Org-roam
;; with the help of Graphviz.
;;
;;; Code:
(require 'xml) ;xml-escape-string
(require 'org-roam)
;;; Options
(defcustom org-roam-graph-viewer (executable-find "firefox")
"Method to view the org-roam graph.
It may be one of the following:
- a string representing the path to the executable for viewing the graph.
- a function accepting a single argument: the graph file path.
- nil uses `view-file' to view the graph."
:type '(choice
(string :tag "Path to executable")
(function :tag "Function to display graph" eww-open-file)
(const :tag "view-file"))
:group 'org-roam)
(defcustom org-roam-graph-executable "dot"
"Path to graphing executable, or its name."
:type 'string
:group 'org-roam)
(defcustom org-roam-graph-filetype "svg"
"File type to generate when producing graphs."
:type 'string
:group 'org-roam)
(defcustom org-roam-graph-extra-config nil
"Extra options passed to graphviz.
Example:
((\"rankdir\" . \"LR\"))"
:type 'alist
:group 'org-roam)
(defcustom org-roam-graph-edge-extra-config nil
"Extra edge options passed to graphviz.
Example:
((\"dir\" . \"back\"))"
:type 'alist
:group 'org-roam)
(defcustom org-roam-graph-node-extra-config
'(("id" . (("style" . "bold,rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#111111")))
("http" . (("style" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6")))
("https" . (("style" . "rounded,filled")
("fillcolor" . "#EEEEEE")
("color" . "#C9C9C9")
("fontcolor" . "#0A97A6"))))
"Extra options for graphviz nodes."
:type '(alist)
:group 'org-roam)
(defcustom org-roam-graph-link-hidden-types
'("file")
"What sort of links to hide from the Org-roam graph."
:type '(repeat string)
:group 'org-roam)
(defcustom org-roam-graph-max-title-length 100
"Maximum length of titles in graph nodes."
:type 'number
:group 'org-roam)
(defcustom org-roam-graph-shorten-titles 'truncate
"Determines how long titles appear in graph nodes.
Recognized values are the symbols `truncate' and `wrap', in which
cases the title will be truncated or wrapped, respectively, if it
is longer than `org-roam-graph-max-title-length'.
All other values including nil will have no effect."
:type '(choice
(const :tag "truncate" truncate)
(const :tag "wrap" wrap)
(const :tag "no" nil))
:group 'org-roam)
(defcustom org-roam-graph-link-builder 'org-roam-org-protocol-link-builder
"Function used to build the Org-roam graph links.
Given a node name, return a string to be used for the link fed to
the graph generation utility."
:type 'function
:group 'org-roam)
(defcustom org-roam-graph-generation-hook nil
"Functions to run after the graph has been generated.
Each function is called with two arguments: the filename
containing the graph generation tool, and the generated graph."
:type 'hook
:group 'org-roam)
(defun org-roam-org-protocol-link-builder (node)
"Default org-roam link builder. Generate an org-protocol link using NODE."
(concat "org-protocol://roam-node?node="
(url-hexify-string (org-roam-node-id node))))
;;; Interactive command
;;;###autoload
(defun org-roam-graph (&optional arg node)
"Build and possibly display a graph for NODE.
ARG may be any of the following values:
- nil show the graph.
- `\\[universal-argument]' show the graph for NODE.
- `\\[universal-argument]' N show the graph for NODE limiting nodes to N steps."
(interactive
(list current-prefix-arg
(and current-prefix-arg
(org-roam-node-at-point 'assert))))
(let ((graph (cl-typecase arg
(null (org-roam-graph--dot nil 'all-nodes))
(cons (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) 0)))
(integer (org-roam-graph--dot (org-roam-graph--connected-component
(org-roam-node-id node) (abs arg)))))))
(org-roam-graph--build graph #'org-roam-graph--open)))
;;; Generation and Build process
(defun org-roam-graph--build (graph &optional callback)
"Generate the GRAPH, and execute CALLBACK when process exits successfully.
CALLBACK is passed the graph file as its sole argument."
(unless (stringp org-roam-graph-executable)
(user-error "`org-roam-graph-executable' is not a string"))
(unless (executable-find org-roam-graph-executable)
(user-error (concat "Cannot find executable \"%s\" to generate the graph. "
"Please adjust `org-roam-graph-executable'")
org-roam-graph-executable))
(let* ((temp-dot (make-temp-file "graph." nil ".dot" graph))
(temp-graph (make-temp-file "graph." nil (concat "." org-roam-graph-filetype))))
(org-roam-message "building graph")
(make-process
:name "*org-roam-graph*"
:buffer " *org-roam-graph*"
:command `(,org-roam-graph-executable ,temp-dot "-T" ,org-roam-graph-filetype "-o" ,temp-graph)
:sentinel (when callback
(lambda (process _event)
(when (= 0 (process-exit-status process))
(progn (funcall callback temp-graph)
(run-hook-with-args 'org-roam-graph-generation-hook temp-dot temp-graph))))))))
(defun org-roam-graph--dot (&optional edges all-nodes)
"Build the graphviz given the EDGES of the graph.
If ALL-NODES, include also nodes without edges."
(let ((org-roam-directory-temp org-roam-directory)
(nodes-table (make-hash-table :test #'equal))
(seen-nodes (list))
(edges (or edges (org-roam-db-query [:select :distinct [source dest type] :from links]))))
(pcase-dolist (`(,id ,file ,title)
(org-roam-db-query [:select [id file title] :from nodes]))
(puthash id (org-roam-node-create :file file :id id :title title) nodes-table))
(with-temp-buffer
(setq-local org-roam-directory org-roam-directory-temp)
(insert "digraph \"org-roam\" {\n")
(dolist (option org-roam-graph-extra-config)
(insert (org-roam-graph--dot-option option) ";\n"))
(insert (format " edge [%s];\n"
(mapconcat (lambda (var)
(org-roam-graph--dot-option var nil "\""))
org-roam-graph-edge-extra-config
",")))
(pcase-dolist (`(,source ,dest ,type) edges)
(unless (member type org-roam-graph-link-hidden-types)
(pcase-dolist (`(,node ,node-type) `((,source "id")
(,dest ,type)))
(unless (member node seen-nodes)
(insert (org-roam-graph--format-node
(or (gethash node nodes-table) node) node-type))
(push node seen-nodes)))
(insert (format " \"%s\" -> \"%s\";\n"
(xml-escape-string source)
(xml-escape-string dest)))))
(when all-nodes
(maphash (lambda (id node)
(unless (member id seen-nodes)
(insert (org-roam-graph--format-node node "id"))))
nodes-table))
(insert "}")
(buffer-string))))
(defun org-roam-graph--connected-component (id distance)
"Return the edges for all nodes reachable from/connected to ID.
DISTANCE is the maximum distance away from the root node."
(let* ((query
(if (= distance 0)
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source) AS
(SELECT dest FROM links_of WHERE source = $s1 UNION
SELECT dest FROM links_of JOIN connected_component USING(source))
SELECT DISTINCT source, dest, type FROM links
WHERE source IN connected_component OR dest IN connected_component;"
"
WITH RECURSIVE
links_of(source, dest) AS
(SELECT source, dest FROM links UNION
SELECT dest, source FROM links),
connected_component(source, trace) AS
(VALUES ($s1 , json_array($s1)) UNION
SELECT lo.dest, json_insert(cc.trace, '$[' || json_array_length(cc.trace) || ']', lo.dest) FROM
connected_component AS cc JOIN links_of AS lo USING(source)
WHERE (
-- Avoid cycles by only visiting each node once.
(SELECT count(*) FROM json_each(cc.trace) WHERE json_each.value == lo.dest) == 0
-- Note: BFS is cut off early here.
AND json_array_length(cc.trace) < $s2)),
nodes(source) as (SELECT DISTINCT source
FROM connected_component GROUP BY source ORDER BY min(json_array_length(trace)))
SELECT DISTINCT source, dest, type FROM links WHERE source IN nodes OR dest IN nodes;")))
(org-roam-db-query query id distance)))
(defun org-roam-graph--dot-option (option &optional wrap-key wrap-val)
"Return dot string of form KEY=VAL for OPTION cons.
If WRAP-KEY is non-nil it wraps the KEY.
If WRAP-VAL is non-nil it wraps the VAL."
(concat wrap-key (car option) wrap-key
"="
wrap-val (cdr option) wrap-val))
(defun org-roam-graph--format-node (node type)
"Return a graphviz NODE with TYPE.
Handles both Org-roam nodes, and string nodes (e.g. urls)."
(let (node-id node-properties)
(if (org-roam-node-p node)
(let* ((title (org-roam-quote-string (org-roam-node-title node)))
(shortened-title
(org-roam-quote-string
(pcase org-roam-graph-shorten-titles
(`truncate (truncate-string-to-width title org-roam-graph-max-title-length nil nil "..."))
(`wrap (org-roam-word-wrap org-roam-graph-max-title-length title))
(_ title)))))
(setq node-id (org-roam-node-id node)
node-properties `(("label" . ,shortened-title)
("URL" . ,(funcall org-roam-graph-link-builder node))
("tooltip" . ,(xml-escape-string title)))))
(setq node-id node
node-properties (append `(("label" . ,(concat type ":" node)))
(when (member type (list "http" "https"))
`(("URL" . ,(xml-escape-string (concat type ":" node))))))))
(format "\"%s\" [%s];\n"
node-id
(mapconcat (lambda (n)
(org-roam-graph--dot-option n nil "\""))
(append (cdr (assoc type org-roam-graph-node-extra-config))
node-properties) ","))))
(defun org-roam-graph--open (file)
"Open FILE using `org-roam-graph-viewer' with `view-file' as a fallback."
(pcase org-roam-graph-viewer
((pred stringp)
(if (executable-find org-roam-graph-viewer)
(condition-case err
(call-process org-roam-graph-viewer nil 0 nil file)
(error (user-error "Failed to open org-roam graph: %s" err)))
(user-error "Executable not found: \"%s\"" org-roam-graph-viewer)))
((pred functionp) (funcall org-roam-graph-viewer file))
('nil (view-file file))
(_ (signal 'wrong-type-argument `((functionp stringp null) ,org-roam-graph-viewer)))))
(provide 'org-roam-graph)
;;; org-roam-graph.el ends here

Binary file not shown.

View File

@@ -0,0 +1,88 @@
;;; org-roam-id.el --- ID-related utilities for Org-roam -*- lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This module provides ID-related facilities using the Org-roam database.
;;
;;; Code:
(require 'org-id)
(defun org-roam-id-at-point ()
"Return the ID at point, if any.
Recursively traverses up the headline tree to find the
first encapsulating ID."
(org-with-wide-buffer
(org-back-to-heading-or-point-min t)
(while (and (not (org-roam-db-node-p))
(not (bobp)))
(org-roam-up-heading-or-point-min))
(when (org-roam-db-node-p)
(org-id-get))))
(defun org-roam-id-find (id &optional markerp)
"Return the location of the entry with the id ID using the Org-roam db.
The return value is a cons cell (file-name . position), or nil
if there is no entry with that ID.
With optional argument MARKERP, return the position as a new marker."
(cond
((symbolp id) (setq id (symbol-name id)))
((numberp id) (setq id (number-to-string id))))
(let ((node (org-roam-populate (org-roam-node-create :id id))))
(when-let* ((file (org-roam-node-file node)))
(if markerp
(let ((buffer (or (find-buffer-visiting file)
(find-file-noselect file))))
(with-current-buffer buffer
(move-marker (make-marker) (org-roam-node-point node) buffer)))
(cons (org-roam-node-file node)
(org-roam-node-point node))))))
(defalias 'org-roam-id-open 'org-id-open
"Obsolete alias - use `org-id-open' directly.")
(advice-add 'org-id-find :before-until #'org-roam-id-find)
;;;###autoload
(defun org-roam-update-org-id-locations (&rest directories)
"Scan Org-roam files to update `org-id' related state.
This is like `org-id-update-id-locations', but will automatically
use the currently bound `org-directory' and `org-roam-directory'
along with DIRECTORIES (if any), where the lookup for files in
these directories will be always recursive.
Note: Org-roam doesn't have hard dependency on
`org-id-locations-file' to lookup IDs for nodes that are stored
in the database, but it still tries to properly integrates with
`org-id'. This allows the user to cross-reference IDs outside of
the current `org-roam-directory', and also link with \"id:\"
links to headings/files within the current `org-roam-directory'
that are excluded from identification in Org-roam as
`org-roam-node's, e.g. with \"ROAM_EXCLUDE\" property."
(interactive)
(cl-loop for dir in (cons org-roam-directory directories)
for org-roam-directory = dir
nconc (org-roam-list-files) into files
finally (org-id-update-id-locations files org-roam-verbose)))
(provide 'org-roam-id)
;;; org-roam-id.el ends here

Binary file not shown.

View File

@@ -0,0 +1,47 @@
;;; org-roam-log.el --- Integrations with Org-log -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2022-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This module provides integrations with Org-log.
;;
;;; Code:
(require 'org-roam)
(defcustom org-roam-log-setup-hook nil
"Hook run when a log for an Org-roam file is setup."
:group 'org-roam
:type 'hook)
(defun org-roam-log-p ()
"Return t if the log buffer is for an Org-roam file, nil otherwise."
(and org-log-note-marker
(org-roam-file-p (buffer-file-name (marker-buffer org-log-note-marker)))))
(defun org-roam-log--setup ()
"Run hooks in `org-roam-log-setup-hook'."
(run-hooks 'org-roam-log-setup-hook))
(add-hook 'org-roam-log-setup-hook #'org-roam--register-completion-functions-h)
(add-hook 'org-log-buffer-setup-hook #'org-roam-log--setup)
(provide 'org-roam-log)
;;; org-roam-log.el ends here

Binary file not shown.

View File

@@ -0,0 +1,162 @@
;;; org-roam-migrate.el --- Migration utilities from v1 to v2 -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This is a special library provided for the v1 users of this package. It's
;; purpose is to ease the transition from v1 to v2, by providing migration
;; utilities to convert from v1 notes to v2 nodes.
;;
;;; Code:
(require 'org-roam)
;;; Migration wizard (v1 -> v2)
;;;###autoload
(defun org-roam-migrate-wizard ()
"Migrate all notes from to be compatible with Org-roam v2.
1. Convert all notes from v1 format to v2.
2. Rebuild the cache.
3. Replace all file links with ID links."
(interactive)
(when (yes-or-no-p "Org-roam will now convert all your notes from v1 to v2.
This will take a while. Are you sure you want to do this?")
;; Back up notes
(let ((backup-dir (expand-file-name "org-roam.bak"
(file-name-directory (directory-file-name org-roam-directory)))))
(message "Backing up files to %s" backup-dir)
(copy-directory org-roam-directory backup-dir))
;; Upgrade database to v2
(org-roam-db-sync 'force)
;; Convert v1 to v2
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-v1-to-v2)))
;; Rebuild cache
(org-roam-db-sync 'force)
;;Replace all file links with ID links
(dolist (f (org-roam-list-files))
(org-roam-with-file f nil
(org-roam-migrate-replace-file-links-with-id)
(save-buffer)))))
(defun org-roam-migrate-v1-to-v2 ()
"Convert the current buffer to v2 format."
;; Create file level ID
(org-with-point-at 1
(org-id-get-create))
;; Replace roam_key into properties drawer roam_ref
(when-let* ((refs (mapcan #'split-string-and-unquote
(cdar (org-collect-keywords '("roam_key"))))))
(let ((case-fold-search t))
(org-with-point-at 1
(dolist (ref refs)
(org-roam-ref-add ref))
(while (re-search-forward "^#\\+roam_key:" (point-max) t)
(beginning-of-line)
(kill-line 1)))))
;; Replace roam_alias into properties drawer roam_aliases
(when-let* ((aliases (mapcan #'split-string-and-unquote
(cdar (org-collect-keywords '("roam_alias"))))))
(dolist (alias aliases)
(org-roam-alias-add alias)))
(let ((case-fold-search t))
(org-with-point-at 1
(while (re-search-forward "^#\\+roam_alias:" (point-max) t)
(beginning-of-line)
(kill-line 1))))
;; Replace #+roam_tags into #+filetags
(org-with-point-at 1
(let* ((roam-tags (org-roam-migrate-get-prop-list "ROAM_TAGS"))
(file-tags (cl-mapcan (lambda (value)
(cl-mapcan
(lambda (k) (org-split-string k ":"))
(split-string value)))
(org-roam-migrate-get-prop-list "FILETAGS")))
(tags (append roam-tags file-tags))
(tags (seq-map (lambda (tag)
(replace-regexp-in-string
"[^[:alnum:]_@#%]"
"_"
tag)) tags))
(tags (seq-uniq tags)))
(when tags
(org-roam-migrate-prop-set "filetags" (org-make-tag-string tags))))
(let ((case-fold-search t))
(org-with-point-at 1
(while (re-search-forward "^#\\+roam_tags:" (point-max) t)
(beginning-of-line)
(kill-line 1)))))
(save-buffer))
(defun org-roam-migrate-get-prop-list (keyword)
"Return prop list for KEYWORD."
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase keyword)))
lst)
(goto-char (point-min))
(while (re-search-forward re 2048 t)
(setq lst (append lst (split-string-and-unquote
(buffer-substring-no-properties
(match-beginning 1) (match-end 1))))))
lst))
(defun org-roam-migrate-prop-set (name value)
"Set a file property called NAME to VALUE in buffer file.
If the property is already set, replace its value."
(setq name (downcase name))
(org-with-point-at 1
(let ((case-fold-search t))
(if (re-search-forward (concat "^#\\+" name ":\\(.*\\)")
(point-max) t)
(replace-match (concat "#+" name ": " value) 'fixedcase)
(while (and (not (eobp))
(looking-at "^[#:]"))
(if (save-excursion (end-of-line) (eobp))
(progn
(end-of-line)
(insert "\n"))
(forward-line)
(beginning-of-line)))
(insert "#+" name ": " value "\n")))))
(defun org-roam-migrate-replace-file-links-with-id ()
"Replace all file: links with ID links in current buffer."
(org-with-point-at 1
(while (re-search-forward org-link-bracket-re nil t)
(let* ((mdata (match-data))
(path (match-string 1))
(desc (match-string 2)))
(when (string-prefix-p "file:" path)
(setq path (expand-file-name (substring path 5)))
(when-let* ((node-id (caar (org-roam-db-query [:select [id] :from nodes
:where (= file $s1)
:and (= level 0)] path))))
(set-match-data mdata)
(replace-match (org-link-make-string (concat "id:" node-id)
desc) nil t)))))))
(provide 'org-roam-migrate)
;;; org-roam-migrate.el ends here

Binary file not shown.

View File

@@ -0,0 +1,722 @@
;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This module implements `org-roam-mode', which is a major mode that used by
;; special Org-roam buffers to display various content in a section-like manner
;; about the nodes and relevant to them information (e.g. backlinks) with which
;; the user can interact with.
;;
;;; Code:
(require 'org-roam)
;;;; Declarations
(defvar org-ref-buffer-hacked)
;;; Options
(defcustom org-roam-mode-sections (list #'org-roam-backlinks-section
#'org-roam-reflinks-section)
"A list of sections for the `org-roam-mode' based buffers.
Each section is a function that is passed the `org-roam-node'
for which the section will be constructed as the first
argument. Normally this node is `org-roam-buffer-current-node'.
The function may also accept other optional arguments. Each item
in the list is either:
1. A function, which is called only with the `org-roam-node' as the argument
2. A list, containing the function and the optional arguments.
For example, one can add
(org-roam-backlinks-section :unique t)
to the list to pass :unique t to the section-rendering function."
:group 'org-roam
:type `(repeat (choice (symbol :tag "Function")
(list :tag "Function with arguments"
(symbol :tag "Function")
(repeat :tag "Arguments" :inline t (sexp :tag "Arg"))))))
(defcustom org-roam-buffer-postrender-functions (list)
"Functions to run after the Org-roam buffer is rendered.
Each function accepts no arguments, and is run with the Org-roam
buffer as the current buffer."
:group 'org-roam
:type 'hook)
(defcustom org-roam-preview-function #'org-roam-preview-default-function
"The preview function to use to populate the Org-roam buffer.
The function takes no arguments, but the point is temporarily set
to the exact location of the backlink."
:group 'org-roam
:type 'function)
(defcustom org-roam-preview-postprocess-functions (list #'org-roam-strip-comments)
"A list of functions to postprocess the preview content.
Each function takes a single argument, the string for the preview
content, and returns the post-processed string. The functions are
applied in order of appearance in the list."
:group 'org-roam
:type 'hook)
;;; Faces
(defface org-roam-header-line
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "DarkGoldenrod4"
:weight bold)
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:foreground "LightGoldenrod2"
:weight bold))
"Face for the `header-line' in some Org-roam modes."
:group 'org-roam-faces)
(defface org-roam-title
'((t :weight bold))
"Face for Org-roam titles."
:group 'org-roam-faces)
(defface org-roam-olp
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"Face for the OLP of the node."
:group 'org-roam-faces)
(defface org-roam-preview-heading
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey80"
:foreground "grey30")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey25"
:foreground "grey70"))
"Face for preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-heading-highlight
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey75"
:foreground "grey30")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:background "grey35"
:foreground "grey70"))
"Face for current preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-heading-selection
`((((class color) (background light))
,@(and (>= emacs-major-version 27) '(:extend t))
:inherit org-roam-preview-heading-highlight
:foreground "salmon4")
(((class color) (background dark))
,@(and (>= emacs-major-version 27) '(:extend t))
:inherit org-roam-preview-heading-highlight
:foreground "LightSalmon3"))
"Face for selected preview headings."
:group 'org-roam-faces)
(defface org-roam-preview-region
`((t :inherit bold
,@(and (>= emacs-major-version 27)
(list :extend (ignore-errors (face-attribute 'region :extend))))))
"Face used by `org-roam-highlight-preview-region-using-face'.
This face is overlaid over text that uses other hunk faces,
and those normally set the foreground and background colors.
The `:foreground' and especially the `:background' properties
should be avoided here. Setting the latter would cause the
loss of information. Good properties to set here are `:weight'
and `:slant'."
:group 'org-roam-faces)
(defface org-roam-dim
'((((class color) (background light)) :foreground "grey60")
(((class color) (background dark)) :foreground "grey40"))
"Face for the dimmer part of the widgets."
:group 'org-roam-faces)
;;; Major mode
(defvar org-roam-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map magit-section-mode-map)
(define-key map [C-return] 'org-roam-buffer-visit-thing)
(define-key map (kbd "C-m") 'org-roam-buffer-visit-thing)
(define-key map [remap revert-buffer] 'org-roam-buffer-refresh)
map)
"Parent keymap for all keymaps of modes derived from `org-roam-mode'.")
(define-derived-mode org-roam-mode magit-section-mode "Org-roam"
"Major mode for displaying relevant information about Org-roam nodes.
This mode is used by special Org-roam buffers, such as persistent
`org-roam-buffer' and dedicated Org-roam buffers
\(`org-roam-buffer-display-dedicated'), which render the
information in a section-like manner (see
`org-roam-mode-sections'), with which the user can
interact with."
:group 'org-roam
(face-remap-add-relative 'header-line 'org-roam-header-line)
;; https://github.com/meedstrom/org-node/issues/149
(setq-local font-lock-defaults nil))
;;; Buffers
(defvar org-roam-buffer-current-node nil
"The node for which an `org-roam-mode' based buffer displays its contents.
This set both, locally and globally. Normally the local value is
only set in the `org-roam-mode' based buffers, while the global
value shows the current node in the persistent `org-roam-buffer'.")
(put 'org-roam-buffer-current-node 'permanent-local t)
(defvar org-roam-buffer-current-directory nil
"The `org-roam-directory' value of `org-roam-buffer-current-node'.
Set both, locally and globally in the same way as
`org-roam-buffer-current-node'.")
(put 'org-roam-buffer-current-directory 'permanent-local t)
;;;; Library
(defun org-roam-buffer-visit-thing ()
"This is a placeholder command.
Where applicable, section-specific keymaps bind another command
which visits the thing at point."
(interactive)
(user-error "There is no thing at point that could be visited"))
(defun org-roam-buffer-file-at-point (&optional assert)
"Return the file at point in the current `org-roam-mode' based buffer.
If ASSERT, throw an error."
(if-let* ((file (magit-section-case
(org-roam-node-section (org-roam-node-file (oref it node)))
(org-roam-grep-section (oref it file))
(org-roam-preview-section (oref it file))
(t (cl-assert (derived-mode-p 'org-roam-mode))))))
file
(when assert
(user-error "No file at point"))))
(defun org-roam-buffer-refresh ()
"Refresh the contents of the currently selected Org-roam buffer."
(interactive)
(cl-assert (derived-mode-p 'org-roam-mode))
(save-excursion (org-roam-buffer-render-contents)))
(defun org-roam-buffer-render-contents ()
"Recompute and render the contents of an Org-roam buffer.
Assumes that the current buffer is an `org-roam-mode' based
buffer."
(let ((inhibit-read-only t))
(erase-buffer)
(org-roam-mode)
(setq-local default-directory org-roam-buffer-current-directory)
(setq-local org-roam-directory org-roam-buffer-current-directory)
(org-roam-buffer-set-header-line-format
(org-roam-node-title org-roam-buffer-current-node))
(magit-insert-section (org-roam)
(magit-insert-heading)
(dolist (section org-roam-mode-sections)
(pcase section
((pred functionp)
(funcall section org-roam-buffer-current-node))
(`(,fn . ,args)
(apply fn (cons org-roam-buffer-current-node args)))
(_
(user-error "Invalid `org-roam-mode-sections' specification")))))
(run-hooks 'org-roam-buffer-postrender-functions)
(goto-char 0)))
(defun org-roam-buffer-set-header-line-format (string)
"Set the header-line using STRING.
If the `face' property of any part of STRING is already set, then
that takes precedence. Also pad the left side of STRING so that
it aligns with the text area."
(setq-local header-line-format
(concat (propertize " " 'display '(space :align-to 0))
string)))
;;;; Dedicated buffer
;;;###autoload
(defun org-roam-buffer-display-dedicated (node)
"Launch NODE dedicated Org-roam buffer.
Unlike the persistent `org-roam-buffer', the contents of this
buffer won't be automatically changed and will be held in place.
In interactive calls prompt to select NODE, unless called with
`universal-argument', in which case NODE will be set to
`org-roam-node-at-point'."
(interactive
(list (if current-prefix-arg
(org-roam-node-at-point 'assert)
(org-roam-node-read nil nil nil 'require-match))))
(let ((buffer (get-buffer-create (org-roam-buffer--dedicated-name node))))
(with-current-buffer buffer
(setq-local org-roam-buffer-current-node node)
(setq-local org-roam-buffer-current-directory org-roam-directory)
(org-roam-buffer-render-contents))
(display-buffer buffer)))
(defun org-roam-buffer--dedicated-name (node)
"Construct buffer name for NODE dedicated Org-roam buffer."
(let ((title (org-roam-node-title node))
(filename (file-relative-name (org-roam-node-file node) org-roam-directory)))
(format "*org-roam: %s<%s>*" title filename)))
(defun org-roam-buffer-dedicated-p (&optional buffer)
"Return t if an Org-roam BUFFER is a node dedicated one.
See `org-roam-buffer-display-dedicated' for more details.
If BUFFER is nil, default it to `current-buffer'."
(or buffer (setq buffer (current-buffer)))
(string-match-p (concat "^" (regexp-quote "*org-roam: "))
(buffer-name buffer)))
;;;; Persistent buffer
(defvar org-roam-buffer "*org-roam*"
"The persistent Org-roam buffer name. Must be surround with \"*\".
The content inside of this buffer will be automatically updated
to the nearest node at point that comes from the current buffer.
To toggle its display use `org-roam-buffer-toggle' command.")
(defun org-roam-buffer-toggle ()
"Toggle display of the persistent `org-roam-buffer'."
(interactive)
(pcase (org-roam-buffer--visibility)
('visible
(progn
(quit-window nil (get-buffer-window org-roam-buffer))
(remove-hook 'post-command-hook #'org-roam-buffer--redisplay-h)))
((or 'exists 'none)
(progn
(display-buffer (get-buffer-create org-roam-buffer))
(org-roam-buffer-persistent-redisplay)))))
(define-inline org-roam-buffer--visibility ()
"Return the current visibility state of the persistent `org-roam-buffer'.
Valid states are `visible', `exists' and `none'."
(declare (side-effect-free t))
(inline-quote
(cond
((get-buffer-window org-roam-buffer) 'visible)
((get-buffer org-roam-buffer) 'exists)
(t 'none))))
(defun org-roam-buffer-persistent-redisplay ()
"Recompute contents of the persistent `org-roam-buffer'.
Has no effect when there's no `org-roam-node-at-point'."
(when-let* ((node (org-roam-node-at-point)))
(unless (equal node org-roam-buffer-current-node)
(setq org-roam-buffer-current-node node
org-roam-buffer-current-directory org-roam-directory)
(with-current-buffer (get-buffer-create org-roam-buffer)
(org-roam-buffer-render-contents)
(add-hook 'kill-buffer-hook #'org-roam-buffer--persistent-cleanup-h nil t)))))
(defun org-roam-buffer--persistent-cleanup-h ()
"Clean-up global state that's dedicated for the persistent `org-roam-buffer'."
(setq-default org-roam-buffer-current-node nil
org-roam-buffer-current-directory nil))
(add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h)
(defun org-roam-buffer--setup-redisplay-h ()
"Setup automatic redisplay of the persistent `org-roam-buffer'."
(add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t))
(defun org-roam-buffer--redisplay-h ()
"Reconstruct the persistent `org-roam-buffer'.
This needs to be quick or infrequent, because this designed to
run at `post-command-hook'."
(and (get-buffer-window org-roam-buffer)
(org-roam-buffer-persistent-redisplay)))
;;; Sections
;;;; Node
(defvar org-roam-node-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-node-visit)
map)
"Keymap for `org-roam-node-section's.")
(defclass org-roam-node-section (magit-section)
((keymap :initform 'org-roam-node-map)
(node :initform nil))
"A `magit-section' used by `org-roam-mode' to outline NODE in its own heading.")
(cl-defun org-roam-node-insert-section (&key source-node point properties)
"Insert section for a link from SOURCE-NODE to some other node.
The other node is normally `org-roam-buffer-current-node'.
SOURCE-NODE is an `org-roam-node' that links or references with
the other node.
POINT is a character position where the link is located in
SOURCE-NODE's file.
PROPERTIES (a plist) contains additional information about the
link.
Despite the name, this function actually inserts 2 sections at
the same time:
1. `org-roam-node-section' for a heading that describes
SOURCE-NODE. Acts as a parent section of the following one.
2. `org-roam-preview-section' for a preview content that comes
from SOURCE-NODE's file for the link (that references the
other node) at POINT. Acts a child section of the previous
one."
(magit-insert-section section (org-roam-node-section)
(let ((outline (if-let* ((outline (plist-get properties :outline)))
(mapconcat #'org-link-display-format outline " > ")
"Top")))
(insert (concat (propertize (org-roam-node-title source-node)
'font-lock-face 'org-roam-title)
(format " (%s)"
(propertize outline 'font-lock-face 'org-roam-olp)))))
(magit-insert-heading)
(oset section node source-node)
(magit-insert-section section (org-roam-preview-section)
(insert (org-roam-fontify-like-in-org-mode
(org-roam-preview-get-contents (org-roam-node-file source-node) point))
"\n")
(oset section file (org-roam-node-file source-node))
(oset section point point)
(insert ?\n))))
;;;; Preview
(defvar org-roam-preview-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-preview-visit)
map)
"Keymap for `org-roam-preview-section's.")
(defclass org-roam-preview-section (magit-section)
((keymap :initform 'org-roam-preview-map)
(file :initform nil)
(point :initform nil))
"A `magit-section' used by `org-roam-mode' to contain preview content.
The preview content comes from FILE, and the link as at POINT.")
(defun org-roam-preview-visit (file point &optional other-window)
"Visit FILE at POINT and return the visited buffer.
With OTHER-WINDOW non-nil do so in another window.
In interactive calls OTHER-WINDOW is set with
`universal-argument'."
(interactive (list (org-roam-buffer-file-at-point 'assert)
(oref (magit-current-section) point)
current-prefix-arg))
(let ((buf (find-file-noselect file))
(display-buffer-fn (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window)))
(funcall display-buffer-fn buf)
(with-current-buffer buf
(widen)
(goto-char point))
(when (org-invisible-p) (org-fold-show-context))
buf))
(defun org-roam-preview-default-function ()
"Return the preview content at point.
This function returns the all contents under the current
headline, up to the next headline."
(let ((beg (save-excursion
(org-roam-end-of-meta-data t)
(point)))
(end (save-excursion
(org-next-visible-heading 1)
(point))))
(string-trim (buffer-substring-no-properties beg end))))
(defun org-roam-preview-get-contents (file pt)
"Get preview content for FILE at PT."
(save-excursion
(org-roam-with-temp-buffer file
(org-with-wide-buffer
(goto-char pt)
(let ((s (funcall org-roam-preview-function)))
(dolist (fn org-roam-preview-postprocess-functions)
(setq s (funcall fn s)))
s)))))
;;;; Backlinks
(cl-defstruct (org-roam-backlink (:constructor org-roam-backlink-create)
(:copier nil))
source-node target-node
point properties)
(cl-defmethod org-roam-populate ((backlink org-roam-backlink))
"Populate BACKLINK from database."
(setf (org-roam-backlink-source-node backlink)
(org-roam-populate (org-roam-backlink-source-node backlink))
(org-roam-backlink-target-node backlink)
(org-roam-populate (org-roam-backlink-target-node backlink)))
backlink)
(cl-defun org-roam-backlinks-get (node &key unique)
"Return the backlinks for NODE.
When UNIQUE is nil, show all positions where references are found.
When UNIQUE is t, limit to unique sources."
(let* ((sql (if unique
[:select :distinct [source dest pos properties]
:from links
:where (= dest $s1)
:and (= type "id")
:group :by source
:having (funcall min pos)]
[:select [source dest pos properties]
:from links
:where (= dest $s1)
:and (= type "id")]))
(backlinks (org-roam-db-query sql (org-roam-node-id node))))
(cl-loop for backlink in backlinks
collect (pcase-let ((`(,source-id ,dest-id ,pos ,properties) backlink))
(org-roam-populate
(org-roam-backlink-create
:source-node (org-roam-node-create :id source-id)
:target-node (org-roam-node-create :id dest-id)
:point pos
:properties properties))))))
(defun org-roam-backlinks-sort (a b)
"Default sorting function for backlinks A and B.
Sorts by title."
(string< (org-roam-node-title (org-roam-backlink-source-node a))
(org-roam-node-title (org-roam-backlink-source-node b))))
(cl-defun org-roam-backlinks-section (node &key (unique nil) (show-backlink-p nil)
(section-heading "Backlinks:"))
"The backlinks section for NODE.
When UNIQUE is nil, show all positions where references are found.
When UNIQUE is t, limit to unique sources.
When SHOW-BACKLINK-P is not null, only show backlinks for which
this predicate is not nil.
SECTION-HEADING is the string used as a heading for the backlink section."
(when-let* ((backlinks (seq-sort #'org-roam-backlinks-sort (org-roam-backlinks-get node :unique unique))))
(magit-insert-section (org-roam-backlinks)
(magit-insert-heading section-heading)
(dolist (backlink backlinks)
(when (or (null show-backlink-p)
(and (not (null show-backlink-p))
(funcall show-backlink-p backlink)))
(org-roam-node-insert-section
:source-node (org-roam-backlink-source-node backlink)
:point (org-roam-backlink-point backlink)
:properties (org-roam-backlink-properties backlink))))
(insert ?\n))))
;;;; Reflinks
(cl-defstruct (org-roam-reflink (:constructor org-roam-reflink-create)
(:copier nil))
source-node ref
point properties)
(cl-defmethod org-roam-populate ((reflink org-roam-reflink))
"Populate REFLINK from database."
(setf (org-roam-reflink-source-node reflink)
(org-roam-populate (org-roam-reflink-source-node reflink)))
reflink)
(defun org-roam-reflinks-get (node)
"Return the reflinks for NODE."
(let ((refs (org-roam-db-query [:select :distinct [refs:ref links:source links:pos links:properties]
:from refs
:left-join links
:where (= refs:node-id $s1)
:and (= links:dest refs:ref)
:union
:select :distinct [refs:ref citations:node-id
citations:pos citations:properties]
:from refs
:left-join citations
:where (= refs:node-id $s1)
:and (= citations:cite-key refs:ref)]
(org-roam-node-id node)))
links)
(pcase-dolist (`(,ref ,source-id ,pos ,properties) refs)
(push (org-roam-populate
(org-roam-reflink-create
:source-node (org-roam-node-create :id source-id)
:ref ref
:point pos
:properties properties)) links))
links))
(defun org-roam-reflinks-sort (a b)
"Default sorting function for reflinks A and B.
Sorts by title."
(string< (org-roam-node-title (org-roam-reflink-source-node a))
(org-roam-node-title (org-roam-reflink-source-node b))))
(defun org-roam-reflinks-section (node)
"The reflinks section for NODE."
(when-let* ((refs (org-roam-node-refs node))
(reflinks (seq-sort #'org-roam-reflinks-sort (org-roam-reflinks-get node))))
(magit-insert-section (org-roam-reflinks)
(magit-insert-heading "Reflinks:")
(dolist (reflink reflinks)
(org-roam-node-insert-section
:source-node (org-roam-reflink-source-node reflink)
:point (org-roam-reflink-point reflink)
:properties (org-roam-reflink-properties reflink)))
(insert ?\n))))
;;;; Grep
(defvar org-roam-grep-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map org-roam-mode-map)
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-grep-visit)
map)
"Keymap for Org-roam grep result sections.")
(defclass org-roam-grep-section (magit-section)
((keymap :initform 'org-roam-grep-map)
(file :initform nil)
(row :initform nil)
(col :initform nil))
"A `magit-section' used by `org-roam-mode' to contain grep output.")
(defun org-roam-grep-visit (file &optional other-window row col)
"Visit FILE at row ROW (if any) and column COL (if any). Return the buffer.
With OTHER-WINDOW non-nil (in interactive calls set with
`universal-argument') display the buffer in another window
instead."
(interactive (list (org-roam-buffer-file-at-point t)
current-prefix-arg
(oref (magit-current-section) row)
(oref (magit-current-section) col)))
(let ((buf (find-file-noselect file))
(display-buffer-fn (if other-window
#'switch-to-buffer-other-window
#'pop-to-buffer-same-window)))
(funcall display-buffer-fn buf)
(with-current-buffer buf
(widen)
(goto-char (point-min))
(when row
(forward-line (1- row)))
(when col
(forward-char (1- col))))
(when (org-invisible-p) (org-fold-show-context))
buf))
;;;; Unlinked references
(defvar org-roam-unlinked-references-result-re
(rx (group (one-or-more anything))
":"
(group (one-or-more digit))
":"
(group (one-or-more digit))
":"
(group (zero-or-more anything)))
"Regex for the return result of a ripgrep query.")
(defun org-roam-unlinked-references-preview-line (file row)
"Return the preview line from FILE.
This is the ROW within FILE."
(with-temp-buffer
(insert-file-contents file)
(forward-line (1- row))
(buffer-substring-no-properties
(save-excursion
(beginning-of-line)
(point))
(save-excursion
(end-of-line)
(point)))))
(defun org-roam-unlinked-references--rg-command (titles temp-file)
"Return the ripgrep command searching for TITLES using TEMP-FILE for pattern.
This avoids shell escaping issues by writing the pattern to a file instead
of passing it directly through the shell command line."
;; Write pattern to temp file to avoid shell escaping issues with quotes,
;; spaces, and other special characters in titles
(with-temp-file temp-file
(insert "\\[([^[]]++|(?R))*\\]"
(mapconcat (lambda (title)
;; Use regexp-quote instead of shell-quote-argument
;; since we're writing a regex pattern, not a shell argument
(format "|(\\b%s\\b)" (regexp-quote title)))
titles "")))
(concat "rg --follow --only-matching --vimgrep --pcre2 --ignore-case "
(mapconcat (lambda (glob) (concat "--glob " glob))
(org-roam--list-files-search-globs org-roam-file-extensions)
" ")
" --file " (shell-quote-argument temp-file) " "
(shell-quote-argument (expand-file-name org-roam-directory))))
(defun org-roam-unlinked-references-section (node)
"The unlinked references section for NODE.
References from FILE are excluded."
(when (and (executable-find "rg")
(org-roam-node-title node)
(not (string-match "PCRE2 is not available"
(shell-command-to-string "rg --pcre2-version"))))
(let* ((titles (cons (org-roam-node-title node)
(org-roam-node-aliases node)))
;; Create temp file for the regex pattern
(temp-file (make-temp-file "org-roam-rg-pattern-"))
(rg-command (org-roam-unlinked-references--rg-command titles temp-file)))
;; Use unwind-protect to ensure temp file cleanup even if errors occur
(unwind-protect
(let* ((results (split-string (shell-command-to-string rg-command) "\n"))
f row col match)
(magit-insert-section (unlinked-references)
(magit-insert-heading "Unlinked References:")
(dolist (line results)
(save-match-data
(when (string-match org-roam-unlinked-references-result-re line)
(setq f (match-string 1 line)
row (string-to-number (match-string 2 line))
col (string-to-number (match-string 3 line))
match (match-string 4 line))
(when (and match
(not (file-equal-p (org-roam-node-file node) f))
(member (downcase match) (mapcar #'downcase titles)))
(magit-insert-section section (org-roam-grep-section)
(oset section file f)
(oset section row row)
(oset section col col)
(insert (propertize (format "%s:%s:%s"
(truncate-string-to-width (file-name-base f) 15 nil nil t)
row col) 'font-lock-face 'org-roam-dim)
" "
(org-roam-fontify-like-in-org-mode
(org-roam-unlinked-references-preview-line f row))
"\n"))))))
(insert ?\n)))
;; Clean up temp file - this runs even if an error occurs above
(delete-file temp-file)))))
(provide 'org-roam-mode)
;;; org-roam-mode.el ends here

Binary file not shown.

File diff suppressed because it is too large Load Diff

Binary file not shown.

View File

@@ -0,0 +1,95 @@
;;; org-roam-overlay.el --- Link overlay for [id:] links to Org-roam nodes -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Requires: ((emacs "26.1") (org "9.6") (org-roam "2.1"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This extension allows to render [[id:]] links that don't have an associated
;; descriptor with an overlay that displays the node's current title.
;;
;;; Code:
(require 'org-roam)
(defface org-roam-overlay
'((((class color) (background light))
:background "grey90" :box (:line-width -1 :color "black"))
(((class color) (background dark))
:background "grey10" :box (:line-width -1 :color "white")))
"Face for the Org-roam overlay."
:group 'org-roam-faces)
(defun org-roam-overlay--make (l r &rest props)
"Make an overlay from L to R with PROPS."
(let ((o (make-overlay l (or r l))))
(overlay-put o 'category 'org-roam)
(while props (overlay-put o (pop props) (pop props)))
o))
(defun org-roam-overlay-make-link-overlay (link)
"Create overlay for LINK."
(save-excursion
(save-match-data
(let* ((type (org-element-property :type link))
(id (org-element-property :path link))
(pos (org-element-property :end link))
(desc-p (org-element-property :contents-begin link))
node)
(when (and (string-equal type "id")
(setq node (org-roam-node-from-id id))
(not desc-p))
(org-roam-overlay--make
pos pos
'after-string (format "%s "
(propertize (org-roam-node-title node)
'face 'org-roam-overlay))))))))
(defun org-roam-overlay-enable ()
"Enable Org-roam overlays."
(org-roam-db-map-links
(list #'org-roam-overlay-make-link-overlay)))
(defun org-roam-overlay-disable ()
"Disable Org-roam overlays."
(remove-overlays nil nil 'category 'org-roam))
(defun org-roam-overlay-redisplay ()
"Redisplay Org-roam overlays."
(org-roam-overlay-disable)
(org-roam-overlay-enable))
(define-minor-mode org-roam-overlay-mode
"Overlays for Org-roam ID links.
Org-roam overlay mode is a minor mode. When enabled,
overlay displaying the node's title is displayed."
:lighter " org-roam-overlay"
(if org-roam-overlay-mode
(progn
(org-roam-overlay-enable)
(add-hook 'after-save-hook #'org-roam-overlay-redisplay nil t))
(org-roam-overlay-disable)
(remove-hook 'after-save-hook #'org-roam-overlay-redisplay t)))
(provide 'org-roam-overlay)
;;; org-roam-overlay.el ends here

Binary file not shown.

View File

@@ -0,0 +1,15 @@
;; -*- no-byte-compile: t; lexical-binding: nil -*-
(define-package "org-roam" "20251125.729"
"A database abstraction layer for Org-mode."
'((emacs "26.1")
(compat "30.1")
(dash "2.13")
(org "9.6")
(emacsql "4.1.0")
(magit-section "3.0.0"))
:url "https://github.com/org-roam/org-roam"
:commit "f4ba41cf3d59084e182a5186d432afc9aa3fc423"
:revdesc "f4ba41cf3d59"
:keywords '("org-mode" "roam" "convenience")
:authors '(("Jethro Kuan" . "jethrokuan95@gmail.com"))
:maintainers '(("Jethro Kuan" . "jethrokuan95@gmail.com")))

View File

@@ -0,0 +1,173 @@
;;; org-roam-protocol.el --- Protocol handler for roam:// links -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Requires: ((emacs "26.1") (org "9.6") (org-roam "2.1"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This extension extends `org-protocol', adding custom Org-roam handlers to it
;; to provide the next new protocols:
;;
;; 1. "roam-node": This protocol simply opens the node given by the node ID
;; 2. "roam-ref": This protocol creates or opens the node with the given REF
;;
;; You can find detailed instructions on how to setup the protocol in the
;; documentation for Org-roam.
;;
;;; Code:
(require 'org-protocol)
(require 'ol) ;; for org-link-decode
(require 'org-roam)
;;; Options
(defcustom org-roam-protocol-store-links nil
"Whether to store links when capturing websites with `org-roam-protocol'."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-capture-ref-templates
'(("r" "ref" plain "%?"
:target (file+head "${slug}.org"
"#+title: ${title}")
:unnarrowed t))
"The Org-roam templates used during a capture from the roam-ref protocol.
See `org-roam-capture-templates' for the template documentation."
:group 'org-roam
:type '(repeat
(choice (list :tag "Multikey description"
(string :tag "Keys ")
(string :tag "Description"))
(list :tag "Template entry"
(string :tag "Keys ")
(string :tag "Description ")
(choice :tag "Capture Type " :value entry
(const :tag "Org entry" entry)
(const :tag "Plain list item" item)
(const :tag "Checkbox item" checkitem)
(const :tag "Plain text" plain)
(const :tag "Table line" table-line))
(choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
(file :tag "Template file"))
(list :tag "Function"
(const :format "" function)
(function :tag "Template function")))
(plist :inline t
;; Give the most common options as checkboxes
:options (((const :format "%v " :target)
(choice :tag "Node location"
(list :tag "File"
(const :format "" file)
(string :tag " File"))
(list :tag "File & Head Content"
(const :format "" file+head)
(string :tag " File")
(string :tag " Head Content"))
(list :tag "File & Outline path"
(const :format "" file+olp)
(string :tag " File")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))
(list :tag "File & Head Content & Outline path"
(const :format "" file+head+olp)
(string :tag " File")
(string :tag " Head Content")
(list :tag "Outline path"
(repeat (string :tag "Headline"))))))
((const :format "%v " :prepend) (const t))
((const :format "%v " :immediate-finish) (const t))
((const :format "%v " :jump-to-captured) (const t))
((const :format "%v " :empty-lines) (const 1))
((const :format "%v " :empty-lines-before) (const 1))
((const :format "%v " :empty-lines-after) (const 1))
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
((const :format "%v " :time-prompt) (const t))
((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
((const :format "%v " :table-line-pos) (string))
((const :format "%v " :kill-buffer) (const t))))))))
;;; Handlers
(defun org-roam-protocol-open-ref (info)
"Process an org-protocol://roam-ref?ref= style url with INFO.
It opens or creates a note with the given ref.
javascript:location.href = \\='org-protocol://roam-ref?template=r&ref=\\='+ \\
encodeURIComponent(location.href) + \\='&title=\\=' + \\
encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())"
(unless (plist-get info :ref)
(user-error "No ref key provided"))
(org-roam-plist-map! (lambda (k v)
(org-link-decode
(if (equal k :ref)
(org-protocol-sanitize-uri v)
v))) info)
(when org-roam-protocol-store-links
(push (list (plist-get info :ref)
(plist-get info :title)) org-stored-links))
(org-link-store-props :type (and (string-match org-link-plain-re
(plist-get info :ref))
(match-string 1 (plist-get info :ref)))
:link (plist-get info :ref)
:annotation (org-link-make-string (plist-get info :ref)
(or (plist-get info :title)
(plist-get info :ref)))
:initial (or (plist-get info :body) ""))
(raise-frame)
(let ((org-capture-link-is-already-stored t))
(org-roam-capture-
:keys (plist-get info :template)
:node (org-roam-node-create :title (plist-get info :title))
:info (list :ref (plist-get info :ref)
:body (plist-get info :body))
:templates org-roam-capture-ref-templates))
nil)
(defun org-roam-protocol-open-node (info)
"This handler simply opens the file with emacsclient.
INFO is a plist containing additional information passed by the protocol URL.
It should contain the FILE key, pointing to the path of the file to open.
Example protocol string:
org-protocol://roam-node?node=uuid"
(when-let* ((node (plist-get info :node)))
(raise-frame)
(org-roam-node-visit (org-roam-populate (org-roam-node-create :id node)) nil 'force))
nil)
(push '("org-roam-ref" :protocol "roam-ref" :function org-roam-protocol-open-ref)
org-protocol-protocol-alist)
(push '("org-roam-node" :protocol "roam-node" :function org-roam-protocol-open-node)
org-protocol-protocol-alist)
(provide 'org-roam-protocol)
;;; org-roam-protocol.el ends here

Binary file not shown.

View File

@@ -0,0 +1,442 @@
;;; org-roam-utils.el --- Utilities for Org-roam -*- lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This library provides definitions for utilities that used throughout the
;; whole package.
;;
;;; Code:
(require 'org-roam)
;;; String utilities
;; TODO Refactor this.
(defun org-roam-replace-string (old new s)
"Replace OLD with NEW in S."
(declare (pure t) (side-effect-free t))
(replace-regexp-in-string (regexp-quote old) new s t t))
(defun org-roam-quote-string (s)
"Quotes string S."
(->> s
(org-roam-replace-string "\\" "\\\\")
(org-roam-replace-string "\"" "\\\"")))
(defun org-roam-word-wrap (len s)
"If S is longer than LEN, wrap the words with newlines."
(declare (side-effect-free t))
(save-match-data
(with-temp-buffer
(insert s)
(let ((fill-column len))
(fill-region (point-min) (point-max)))
(buffer-substring (point-min) (point-max)))))
(defun org-roam-string-equal (s1 s2)
"Return t if S1 and S2 are equal.
Like `string-equal', but case-insensitive."
(and (= (length s1) (length s2))
(or (string-equal s1 s2)
(string-equal (downcase s1) (downcase s2)))))
(defun org-roam-whitespace-content (s)
"Return the whitespace content at the end of S."
(with-temp-buffer
(insert s)
(skip-chars-backward " \t\n")
(buffer-substring-no-properties
(point) (point-max))))
(defun org-roam-strip-comments (s)
"Strip Org comments from string S."
(with-temp-buffer
(insert s)
(goto-char (point-min))
(while (not (eobp))
(if (org-at-comment-p)
(delete-region (line-beginning-position)
(progn (forward-line) (point)))
(forward-line)))
(buffer-string)))
;;; List utilities
(defun org-roam-plist-map! (fn plist)
"Map FN over PLIST, modifying it in-place and returning it.
FN must take two arguments: the key and the value."
(let ((plist-index plist))
(while plist-index
(let ((key (pop plist-index)))
(setf (car plist-index) (funcall fn key (car plist-index))
plist-index (cdr plist-index)))))
plist)
;;; File utilities
(defun org-roam-descendant-of-p (a b)
"Return t if A is descendant of B."
(unless (and a b (equal (file-truename a) (file-truename b)))
(string-prefix-p (replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name b) t t)
(replace-regexp-in-string "^\\([A-Za-z]\\):" 'downcase (expand-file-name a) t t))))
(defmacro org-roam-with-file (file keep-buf-p &rest body)
"Execute BODY within FILE.
If FILE is nil, execute BODY in the current buffer.
Kills the buffer if KEEP-BUF-P is nil, and FILE is not yet visited."
(declare (indent 2) (debug t))
`(let* (new-buf
(auto-mode-alist nil)
(find-file-hook nil)
(buf (or (and (not ,file)
(current-buffer)) ;If FILE is nil, use current buffer
(find-buffer-visiting ,file) ; If FILE is already visited, find buffer
(progn
(setq new-buf t)
(find-file-noselect ,file)))) ; Else, visit FILE and return buffer
res)
(with-current-buffer buf
(unless (derived-mode-p 'org-mode)
(delay-mode-hooks
(let ((org-inhibit-startup t)
(org-agenda-files nil))
(org-mode)
(hack-local-variables))))
(setq res (progn ,@body))
(unless (and new-buf (not ,keep-buf-p))
(save-buffer)))
(if (and new-buf (not ,keep-buf-p))
(when (find-buffer-visiting ,file)
(kill-buffer (find-buffer-visiting ,file))))
res))
;;; Buffer utilities
(defmacro org-roam-with-temp-buffer (file &rest body)
"Execute BODY within a temp buffer.
Like `with-temp-buffer', but propagates `org-roam-directory'.
If FILE, set `default-directory' to FILE's directory and insert its contents."
(declare (indent 1) (debug t))
(let ((current-org-roam-directory (make-symbol "current-org-roam-directory")))
`(let ((,current-org-roam-directory org-roam-directory))
(with-temp-buffer
(let ((org-roam-directory ,current-org-roam-directory)
(org-inhibit-startup t))
(delay-mode-hooks (org-mode))
(when ,file
(insert-file-contents ,file)
(setq-local default-directory (file-name-directory ,file)))
,@body)))))
;;; Formatting
(defun org-roam-format-template (template replacer)
"Format TEMPLATE with the function REPLACER.
The templates are of form ${foo} for variable foo, and
${foo=default} for variable foo with default value \"default\".
REPLACER takes an argument of the format variable and the default
value (possibly nil). Adapted from `s-format'."
(let ((saved-match-data (match-data)))
(unwind-protect
(replace-regexp-in-string
"\\${\\([^}]+\\)}"
(lambda (md)
(let ((var (match-string 1 md))
(replacer-match-data (match-data))
default-val)
(when (string-match "\\(.+\\)=\\(.+\\)" var)
(setq default-val (match-string 2 var)
var (match-string 1 var)))
(unwind-protect
(let ((v (progn
(set-match-data saved-match-data)
(funcall replacer var default-val))))
(if v
(format (apply #'propertize "%s" (text-properties-at 0 var)) v)
(signal 'org-roam-format-resolve md)))
(set-match-data replacer-match-data))))
(if (functionp template)
(funcall template)
template)
;; Need literal to make sure it works
t t)
(set-match-data saved-match-data))))
;;; Fontification
(defvar org-ref-buffer-hacked)
(defvar org-roam-fontification-buffer "*org-roam-fontification-buffer*"
"The buffer helps to increase the speed of org-roam-buffer fontification.")
(defun org-roam-get-fontification-buffer-create ()
"Get or create the `org-roam-fontification-buffer'.
This buffer used to fontify multiple backlink previews efficiently (`org-mode' is booted just once)."
(with-current-buffer (get-buffer-create org-roam-fontification-buffer)
(unless (derived-mode-p 'org-mode)
(org-mode))
(current-buffer)))
(defun org-roam-fontify-like-in-org-mode (s)
"Fontify string S like in Org mode.
Like `org-fontify-like-in-org-mode', but supports `org-ref'."
;; NOTE: pretend that the temporary buffer created by `org-fontify-like-in-org-mode' to
;; fontify a `cite:' reference has been hacked by org-ref, whatever that means;
;;
;; `org-ref-cite-link-face-fn', which is used to supply a face for `cite:' links, calls
;; `hack-dir-local-variables' rationalizing that `bibtex-completion' would throw some warnings
;; otherwise. This doesn't seem to be the case and calling this function just before
;; `org-font-lock-ensure' (alias of `font-lock-ensure') actually instead of fixing the alleged
;; warnings messes the things so badly that `font-lock-ensure' crashes with error and doesn't let
;; org-roam to proceed further. I don't know what's happening there exactly but disabling this hackery
;; fixes the crashing. Fortunately, org-ref provides the `org-ref-buffer-hacked' switch, which we use
;; here to make it believe that the buffer was hacked.
;;
;; This is a workaround for `cite:' links and does not have any effect on other ref types.
;;
;; `org-ref-buffer-hacked' is a buffer-local variable, therefore we inline
;; `org-fontify-like-in-org-mode' here
(with-current-buffer (org-roam-get-fontification-buffer-create)
(erase-buffer)
(insert s)
(let ((org-ref-buffer-hacked t))
(setq-local org-fold-core-style 'overlays)
(font-lock-ensure)
(buffer-string))))
;;; Org-mode utilities
;;;; Motions
(defun org-roam-up-heading-or-point-min ()
"Fixed version of Org's `org-up-heading-or-point-min'."
(ignore-errors (org-back-to-heading t))
(let ((p (point)))
(if (< 1 (funcall outline-level))
(progn
(org-up-heading-safe)
(when (= (point) p)
(goto-char (point-min))))
(unless (bobp) (goto-char (point-min))))))
;;;; Keywords
(defun org-roam-get-keyword (name &optional file bound)
"Return keyword property NAME from an org FILE.
FILE defaults to current file.
Only scans up to BOUND bytes of the document."
(unless bound
(setq bound 1024))
(if file
(with-temp-buffer
(insert-file-contents file nil 0 bound)
(org-roam--get-keyword name))
(org-roam--get-keyword name bound)))
(defun org-roam--get-keyword (name &optional bound)
"Return keyword property NAME in current buffer.
If BOUND, scan up to BOUND bytes of the buffer."
(save-excursion
(let ((re (format "^#\\+%s:[ \t]*\\([^\n]+\\)" (upcase name))))
(goto-char (point-min))
(when (re-search-forward re bound t)
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))
(defun org-roam-end-of-meta-data (&optional full)
"Like `org-end-of-meta-data', but supports file-level metadata.
When FULL is non-nil but not t, skip planning information,
properties, clocking lines and logbook drawers.
When optional argument FULL is t, skip everything above, and also
skip keywords."
(org-back-to-heading-or-point-min t)
(when (org-at-heading-p) (forward-line))
;; Skip planning information.
(when (looking-at-p org-planning-line-re) (forward-line))
;; Skip property drawer.
(when (looking-at org-property-drawer-re)
(goto-char (match-end 0))
(forward-line))
;; When FULL is not nil, skip more.
(when (and full (not (org-at-heading-p)))
(catch 'exit
(let ((end (save-excursion (outline-next-heading) (point)))
(re (concat "[ \t]*$" "\\|" org-clock-line-re)))
(while (not (eobp))
(cond ;; Skip clock lines.
((looking-at-p re) (forward-line))
;; Skip logbook drawer.
((looking-at-p org-logbook-drawer-re)
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
(forward-line)
(throw 'exit t)))
((looking-at-p org-drawer-regexp)
(if (re-search-forward "^[ \t]*:END:[ \t]*$" end t)
(forward-line)
(throw 'exit t)))
;; When FULL is t, skip keywords too.
((and (eq full t)
(looking-at-p org-keyword-regexp))
(forward-line))
(t (throw 'exit t))))))))
(defun org-roam-set-keyword (key value)
"Set keyword KEY to VALUE.
If the property is already set, it's value is replaced."
(org-with-point-at 1
(let ((case-fold-search t))
(if (re-search-forward (concat "^#\\+" key ":\\(.*\\)") (point-max) t)
(if (string-blank-p value)
(kill-whole-line)
(replace-match (concat " " value) 'fixedcase nil nil 1))
(org-roam-end-of-meta-data 'drawers)
(if (save-excursion (end-of-line) (eobp))
(progn
(end-of-line)
(insert "\n"))
(forward-line)
(beginning-of-line))
(insert "#+" key ": " value "\n")))))
(defun org-roam-erase-keyword (keyword)
"Erase the line where the KEYWORD is, setting line from the top of the file."
(let ((case-fold-search t))
(org-with-point-at 1
(when (re-search-forward (concat "^#\\+" keyword ":") nil t)
(beginning-of-line)
(delete-region (point) (line-end-position))
(delete-char 1)))))
;;;; Properties
(defun org-roam-add-property (val prop)
"Add VAL value to PROP property for the node at point.
Both, VAL and PROP are strings."
(org-roam-property-add prop val))
(defun org-roam-remove-property (prop &optional val)
"Remove VAL value from PROP property for the node at point.
Both VAL and PROP are strings.
If VAL is not specified, user is prompted to select a value."
(org-roam-property-remove prop val))
(defun org-roam-property-add (prop val)
"Add VAL value to PROP property for the node at point.
Both, VAL and PROP are strings."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(lst (if (memq val lst) lst (cons val lst)))
(lst (seq-uniq lst)))
(org-set-property prop (combine-and-quote-strings lst))
val))
(defun org-roam-property-remove (prop &optional val)
"Remove VAL value from PROP property for the node at point.
Both VAL and PROP are strings.
If VAL is not specified, user is prompted to select a value."
(let* ((p (org-entry-get (point) prop))
(lst (when p (split-string-and-unquote p)))
(prop-to-remove (or val (completing-read "Remove: " lst)))
(lst (delete prop-to-remove lst)))
(if lst
(org-set-property prop (combine-and-quote-strings lst))
(org-delete-property prop))
prop-to-remove))
;;; Refs
(defun org-roam-org-ref-path-to-keys (path)
"Return a list of keys given an org-ref cite: PATH.
Accounts for both v2 and v3."
(cond ((fboundp 'org-ref-parse-cite-path)
(mapcar (lambda (cite) (plist-get cite :key))
(plist-get (org-ref-parse-cite-path path) :references)))
((fboundp 'org-ref-split-and-strip-string)
(org-ref-split-and-strip-string path))))
;;; Logs
(defvar org-roam-verbose)
(defun org-roam-message (format-string &rest args)
"Pass FORMAT-STRING and ARGS to `message' when `org-roam-verbose' is t."
(when org-roam-verbose
(apply #'message `(,(concat "(org-roam) " format-string) ,@args))))
;;; Diagnostics
;; TODO Update this to also get commit hash
;;;###autoload
(defun org-roam-version (&optional message)
"Return `org-roam' version.
Interactively, or when MESSAGE is non-nil, show in the echo area."
(interactive)
(let* ((toplib (or load-file-name buffer-file-name))
gitdir topdir version)
(unless (and toplib (equal (file-name-nondirectory toplib) "org-roam-utils.el"))
(setq toplib (locate-library "org-roam-utils.el")))
(setq toplib (and toplib (org-roam--straight-chase-links toplib)))
(when toplib
(setq topdir (file-name-directory toplib)
gitdir (expand-file-name ".git" topdir)))
(when (file-exists-p gitdir)
(setq version
(let ((default-directory topdir))
(shell-command-to-string "git describe --tags --dirty --always"))))
(unless version
(setq version (with-temp-buffer
(insert-file-contents-literally (locate-library "org-roam.el"))
(goto-char (point-min))
(save-match-data
(if (re-search-forward "\\(?:;; Version: \\([^z-a]*?$\\)\\)" nil nil)
(substring-no-properties (match-string 1))
"N/A")))))
(if (or message (called-interactively-p 'interactive))
(message "%s" version)
version)))
(defun org-roam--straight-chase-links (filename)
"Chase links in FILENAME until a name that is not a link.
This is the same as `file-chase-links', except that it also
handles fake symlinks that are created by the package manager
straight.el on Windows.
See <https://github.com/raxod502/straight.el/issues/520>."
(when (and (bound-and-true-p straight-symlink-emulation-mode)
(fboundp 'straight-chase-emulated-symlink))
(when-let* ((target (straight-chase-emulated-symlink filename)))
(unless (eq target 'broken)
(setq filename target))))
(file-chase-links filename))
;;;###autoload
(defun org-roam-diagnostics ()
"Collect and print info for `org-roam' issues."
(interactive)
(with-current-buffer (switch-to-buffer-other-window (get-buffer-create "*org-roam diagnostics*"))
(erase-buffer)
(insert (propertize "Copy info below this line into issue:\n" 'face '(:weight bold)))
(insert (format "- Emacs: %s\n" (emacs-version)))
(insert (format "- Framework: %s\n"
(condition-case _
(completing-read "I'm using the following Emacs framework:"
'("Doom" "Spacemacs" "N/A" "I don't know"))
(quit "N/A"))))
(insert (format "- Org: %s\n" (org-version nil 'full)))
(insert (format "- Org-roam: %s" (org-roam-version)))
(insert (format "- sqlite-connector: %s"
(if-let* ((conn (org-roam-db--get-connection)))
(eieio-object-class conn)
"not connected")))))
(provide 'org-roam-utils)
;;; org-roam-utils.el ends here

Binary file not shown.

View File

@@ -0,0 +1,364 @@
;;; org-roam.el --- A database abstraction layer for Org-mode -*- coding: utf-8; lexical-binding: t; -*-
;; Copyright © 2020-2025 Jethro Kuan <jethrokuan95@gmail.com>
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
;; URL: https://github.com/org-roam/org-roam
;; Keywords: org-mode, roam, convenience
;; Package-Version: 20251125.729
;; Package-Revision: f4ba41cf3d59
;; Package-Requires: ((emacs "26.1") (compat "30.1") (dash "2.13") (org "9.6") (emacsql "4.1.0") (magit-section "3.0.0"))
;; This file is NOT part of GNU Emacs.
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Org-roam is a Roam Research inspired Emacs package and is an addition to
;; Org-mode to have a way to quickly process complex SQL-like queries over a
;; large set of plain text Org-mode files. To achieve this Org-roam provides a
;; database abstraction layer, the capabilities of which include, but are not
;; limited to:
;;
;; - Link graph traversal and visualization.
;; - Instantaneous SQL-like queries on headlines
;; - What are my TODOs, scheduled for X, or due by Y?
;; - Accessing the properties of a node, such as its tags, refs, TODO state or
;; priority.
;;
;; All of these functionality is powered by this layer. Hence, at its core
;; Org-roam's primary goal is to provide a resilient dual representation of
;; what's already available in plain text, while cached in a binary database,
;; that is cheap to maintain, easy to understand, and is as up-to-date as it
;; possibly can. For users who would like to perform arbitrary programmatic
;; queries on their Org files Org-roam also exposes an API to this database
;; abstraction layer.
;;
;; -----------------------------------------------------------------------------
;;
;; In order for the package to correctly work through your interactive session
;; it's mandatory to add somewhere to your configuration the next form:
;;
;; (org-roam-db-autosync-mode)
;;
;; The form can be called both, before or after loading the package, which is up
;; to your preferences. If you call this before the package is loaded, then it
;; will automatically load the package.
;;
;; -----------------------------------------------------------------------------
;;
;; This package also comes with a set of officially supported extensions that
;; provide extra features. You can find them in the "extensions/" subdirectory.
;; These extensions are not automatically loaded with `org-roam`, but they still
;; will be lazy-loaded through their own `autoload's.
;;
;; Org-roam also has other extensions that don't come together with this package.
;; Such extensions are distributed as their own packages, while also
;; authored and maintained by different people on distinct repositories. The
;; majority of them can be found at https://github.com/org-roam and MELPA.
;;
;;; Code:
(require 'dash)
(require 'rx)
(require 'seq)
(require 'cl-lib)
(require 'compat)
(require 'magit-section)
(require 'emacsql)
;; REVIEW: is this require needed?
;; emacsql-sqlite provides a common interface to an emacsql SQLite backend (e.g. emacs-sqlite-builtin)
;; not to be confused with a backend itself named emacsql-sqlite that existed in emacsql < 4.0.
(require 'emacsql-sqlite)
(require 'org)
(require 'org-attach) ; To set `org-attach-id-dir'
(require 'org-id)
(require 'ol)
(require 'org-element)
(require 'org-capture)
(require 'ansi-color) ; to strip ANSI color codes in `org-roam--list-files'
(eval-when-compile
(require 'subr-x))
;;; Options
(defgroup org-roam nil
"A database abstraction layer for Org-mode."
:group 'org
:prefix "org-roam-"
:link '(url-link :tag "Github" "https://github.com/org-roam/org-roam")
:link '(url-link :tag "Online Manual" "https://www.orgroam.com/manual.html"))
(defgroup org-roam-faces nil
"Faces used by Org-roam."
:group 'org-roam
:group 'faces)
(defcustom org-roam-verbose t
"Echo messages that are not errors."
:type 'boolean
:group 'org-roam)
(defcustom org-roam-directory (expand-file-name "~/org-roam/")
"Default path to Org-roam files.
All Org files, at any level of nesting, are considered part of the Org-roam."
:type 'directory
:group 'org-roam)
(defcustom org-roam-find-file-hook nil
"Hook run when an Org-roam file is visited."
:group 'org-roam
:type 'hook)
(defcustom org-roam-post-node-insert-hook nil
"Hook run when an Org-roam node is inserted as an Org link.
Each function takes two arguments: the id of the node, and the link description."
:group 'org-roam
:type 'hook)
(defcustom org-roam-file-extensions '("org")
"List of file extensions to be included by Org-Roam.
While a file extension different from \".org\" may be used, the
file still needs to be an `org-mode' file, and it is the user's
responsibility to ensure that."
:type '(repeat string)
:group 'org-roam)
(defcustom org-roam-file-exclude-regexp (list org-attach-id-dir)
"Files matching this regexp or list of regexps are excluded from Org-roam."
:type '(choice
(repeat
(string :tag "Regular expression matching files to ignore"))
(string :tag "Regular expression matching files to ignore")
(const :tag "Include everything" nil))
:group 'org-roam)
(defcustom org-roam-list-files-commands
(if (member system-type '(windows-nt ms-dos cygwin))
nil
'(find fd fdfind rg))
"Commands that will be used to find Org-roam files.
It should be a list of symbols or cons cells representing any of
the following supported file search methods.
The commands will be tried in order until an executable for a
command is found. The Elisp implementation is used if no command
in the list is found.
`find'
Use find as the file search method.
Example command:
find /path/to/dir -type f \
\( -name \"*.org\" -o -name \"*.org.gpg\" -name \"*.org.age\" \)
`fd'
Use fd as the file search method.
Example command:
fd /path/to/dir/ --type file -e \".org\" -e \".org.gpg\" -e \".org.age\"
`fdfind'
Same as `fd'. It's an alias that used in some OSes (e.g. Debian, Ubuntu)
`rg'
Use ripgrep as the file search method.
Example command:
rg /path/to/dir/ --files -g \"*.org\" -g \"*.org.gpg\" -g \"*.org.age\"
By default, `executable-find' will be used to look up the path to
the executable. If a custom path is required, it can be specified
together with the method symbol as a cons cell. For example:
\\='(find (rg . \"/path/to/rg\"))."
:type '(set
(const :tag "find" find)
(const :tag "fd" fd)
(const :tag "fdfind" fdfind)
(const :tag "rg" rg)
(const :tag "elisp" nil)))
;;; Library
(defun org-roam-file-p (&optional file)
"Return t if FILE is an Org-roam file, nil otherwise.
If FILE is not specified, use the current buffer's file-path.
FILE is an Org-roam file if:
- It's located somewhere under `org-roam-directory'
- It has a matching file extension (`org-roam-file-extensions')
- It doesn't match excluded regexp (`org-roam-file-exclude-regexp')"
(when (or file (buffer-file-name (buffer-base-buffer)))
(let* ((path (or file (buffer-file-name (buffer-base-buffer))))
(relative-path (file-relative-name path org-roam-directory))
(ext (org-roam--file-name-extension path))
(ext (if (or (string= ext "gpg")
(string= ext "age"))
(org-roam--file-name-extension (file-name-sans-extension path))
ext))
(org-roam-dir-p (org-roam-descendant-of-p path org-roam-directory))
(valid-file-ext-p (member ext org-roam-file-extensions))
(match-exclude-regexp-p
(cond
((not org-roam-file-exclude-regexp) nil)
((stringp org-roam-file-exclude-regexp)
(string-match-p org-roam-file-exclude-regexp relative-path))
((listp org-roam-file-exclude-regexp)
(let (is-match)
(dolist (exclude-re org-roam-file-exclude-regexp)
(setq is-match (or is-match (string-match-p exclude-re relative-path))))
is-match)))))
(save-match-data
(and
path
org-roam-dir-p
valid-file-ext-p
(not match-exclude-regexp-p))))))
;;;###autoload
(defun org-roam-list-files ()
"Return a list of all Org-roam files under `org-roam-directory'.
See `org-roam-file-p' for how each file is determined to be as
part of Org-Roam."
(org-roam--list-files (expand-file-name org-roam-directory)))
(defun org-roam-buffer-p (&optional buffer)
"Return t if BUFFER is for an Org-roam file.
If BUFFER is not specified, use the current buffer."
(let ((buffer (or buffer (current-buffer)))
path)
(with-current-buffer buffer
(and (derived-mode-p 'org-mode)
(setq path (buffer-file-name (buffer-base-buffer)))
(org-roam-file-p path)))))
(defun org-roam-buffer-list ()
"Return a list of buffers that are Org-roam files."
(--filter (org-roam-buffer-p it)
(buffer-list)))
(defun org-roam--file-name-extension (filename)
"Return file name extension for FILENAME.
Like `file-name-extension', but does not strip version number."
(save-match-data
(let ((file (file-name-nondirectory filename)))
(if (and (string-match "\\.[^.]*\\'" file)
(not (eq 0 (match-beginning 0))))
(substring file (+ (match-beginning 0) 1))))))
(defun org-roam--list-files (dir)
"Return all Org-roam files located recursively within DIR.
Use external shell commands if defined in `org-roam-list-files-commands'."
(let (path exe)
(cl-dolist (cmd org-roam-list-files-commands)
(pcase cmd
(`(,e . ,path)
(setq path (executable-find path)
exe (symbol-name e)))
((pred symbolp)
(setq path (executable-find (symbol-name cmd))
exe (symbol-name cmd)))
(wrong-type
(signal 'wrong-type-argument
`((consp symbolp)
,wrong-type))))
(when path (cl-return)))
(if-let* ((files (when path
(let ((fn (intern (concat "org-roam--list-files-" exe))))
(unless (fboundp fn) (user-error "%s is not an implemented search method" fn))
(funcall fn path (format "\"%s\"" dir)))))
(files (seq-filter #'org-roam-file-p files))
(files (mapcar #'expand-file-name files))) ; canonicalize names
files
(org-roam--list-files-elisp dir))))
(defun org-roam--shell-command-files (cmd)
"Run CMD in the shell and return a list of files.
If no files are found, an empty list is returned."
(--> cmd
(shell-command-to-string it)
(ansi-color-filter-apply it)
(split-string it "\n")
(seq-filter (lambda (s)
(not (or (null s) (string= "" s)))) it)))
(defun org-roam--list-files-search-globs (exts)
"Given EXTS, return a list of search globs.
E.g. (\".org\") => (\"*.org\" \"*.org.gpg\")"
(cl-loop for e in exts
append (list (format "\"*.%s\"" e)
(format "\"*.%s.gpg\"" e)
(format "\"*.%s.age\"" e))))
(defun org-roam--list-files-find (executable dir)
"Return all Org-roam files under DIR, using \"find\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(names (string-join (mapcar (lambda (glob) (concat "-name " glob)) globs) " -o "))
(command (string-join `(,executable "-L" ,dir "-type f \\(" ,names "\\)") " ")))
(org-roam--shell-command-files command)))
(defun org-roam--list-files-fd (executable dir)
"Return all Org-roam files under DIR, using \"fd\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(extensions (string-join (mapcar (lambda (glob) (concat "-e " (substring glob 2 -1))) globs) " "))
(command (string-join `(,executable "-L" "--type file" ,extensions "." ,dir) " ")))
(org-roam--shell-command-files command)))
(defalias 'org-roam--list-files-fdfind #'org-roam--list-files-fd)
(defun org-roam--list-files-rg (executable dir)
"Return all Org-roam files under DIR, using \"rg\", provided as EXECUTABLE."
(let* ((globs (org-roam--list-files-search-globs org-roam-file-extensions))
(command (string-join `(
,executable "-L" ,dir "--files"
,@(mapcar (lambda (glob) (concat "-g " glob)) globs)) " ")))
(org-roam--shell-command-files command)))
(declare-function org-roam--directory-files-recursively "org-roam-compat")
(defun org-roam--list-files-elisp (dir)
"Return all Org-roam files under DIR, using Elisp based implementation."
(let ((regex (concat "\\.\\(?:"(mapconcat
#'regexp-quote org-roam-file-extensions
"\\|" )"\\)\\(?:\\.gpg\\|\\.age\\)?\\'"))
result)
(dolist (file (org-roam--directory-files-recursively dir regex nil nil t) result)
(when (and (file-readable-p file)
(org-roam-file-p file))
(push file result)))))
;;; Package bootstrap
(provide 'org-roam)
(cl-eval-when (load eval)
(require 'org-roam-compat)
(require 'org-roam-utils)
(require 'org-roam-db)
(require 'org-roam-node)
(require 'org-roam-id)
(require 'org-roam-capture)
(require 'org-roam-mode)
(require 'org-roam-log)
(require 'org-roam-migrate))
;;; org-roam.el ends here

Binary file not shown.

File diff suppressed because it is too large Load Diff

5
20241210001045-technical.org Normal file → Executable file
View File

@@ -1,7 +1,7 @@
:PROPERTIES:
:ID: 2f285f04-fcf4-4ade-a1ac-2c50b43d529a
:END:
#+title: technical_moc
#+title: Technical MOC
#+filetags: :moc:
In this file I want to include technical information (things related to programming, coding and networking etc):
@@ -18,3 +18,6 @@ In this file I want to include technical information (things related to programm
- [[id:5a207a1c-6f02-40d5-b42e-38daaa0aec10][c_notes]]
- [[id:ae343652-96fe-4341-8a36-ec3a1abd0dc6][java_moc]]
- [[id:f09cb4ed-1407-4187-9002-de2c5db13a8f][server_moc]]
- [[id:631b2086-4b8f-4fe3-829d-be1dc014e293][design-patterns-notes]]
- [[id:37495d5f-2a77-40bc-b45c-8163189bbe6b][technical-commonplace]]

View File

@@ -1,19 +0,0 @@
:PROPERTIES:
:ID: 2f285f04-fcf4-4ade-a1ac-2c50b43d529a
:END:
#+title: technical_moc
#+filetags: :moc:
In this file I want to include technical information (things related to programming, coding and networking etc):
- [[id:e7f2302b-16eb-476d-a7b9-be12f077819d][AOC Notes]]
- [[id:348df473-6443-4f4a-b366-95397b574989][web-port-notes]]
- [[id:710f65e5-0bd4-42be-b5d1-69dbe79b745e][github-notes]]
- [[id:bdb493df-db92-4c93-9558-0b10fdff3048][linux_moc]]
- [[id:e448cd99-afee-4702-947f-644bb34dc1aa][database_moc]]
- [[id:8fa3f476-6152-45f4-b618-50f1e4bce46c][emacs_moc]]
- [[id:0880f089-a5ad-49cd-8ce3-f020a5941313][networking-moc]]
- [[id:9d1cfccc-8da7-41a3-b435-9857f0abe441][leetcode_notes]]
- [[id:347d2663-515b-4d9a-9ee9-7706ee86a845][haskell_notes]]
- [[id:5a207a1c-6f02-40d5-b42e-38daaa0aec10][c_notes]]
- [[id:ae343652-96fe-4341-8a36-ec3a1abd0dc6][java_moc]]

View File

@@ -1,15 +0,0 @@
:PROPERTIES:
:ID: 2f285f04-fcf4-4ade-a1ac-2c50b43d529a
:END:
#+title: Technical Coding
#+filetags: :coding:notes:technical:index:
In this file I want to include technical coding information. This will include things I've learnt from solving:
- [[id:9d1cfccc-8da7-41a3-b435-9857f0abe441][Leetcode Notes]]
- [[id:e7f2302b-16eb-476d-a7b9-be12f077819d][AOC Notes]]
- [[id:347d2663-515b-4d9a-9ee9-7706ee86a845][Haskell Notes]]
- [[id:5a207a1c-6f02-40d5-b42e-38daaa0aec10][C Notes]]
- [[id:348df473-6443-4f4a-b366-95397b574989][web-port-notes]]
- [[id:710f65e5-0bd4-42be-b5d1-69dbe79b745e][github-notes]]
- [[id:ae343652-96fe-4341-8a36-ec3a1abd0dc6][technical-java-notes]]
-

File diff suppressed because it is too large Load Diff

View File

@@ -1,17 +0,0 @@
:PROPERTIES:
:ID: 9d1cfccc-8da7-41a3-b435-9857f0abe441
:END:
#+title: Leetcode Notes
#+filetags: :notes:leetcode:coding:technical:
* Resources:
To work through:
- https://www.youtube.com/watch?v=lvO88XxNAzs&list=LL&index=1&ab_channel=stoneycodes
* Start
[[id:275988a8-59d8-40c8-a8b4-47118d6eb834][big-o-complexity]]
[[id:086ca3ca-39ec-4d37-b56d-b6d9f51e6873][how-to-solve-leetcode]]
[[id:93a43a24-6861-40c4-b45b-581977bb55cf][leetcode-arrays]]

0
20241210004247-emacs_stuff.org Normal file → Executable file
View File

View File

@@ -1,26 +0,0 @@
:PROPERTIES:
:ID: 8fa3f476-6152-45f4-b618-50f1e4bce46c
:END:
#+title: emacs_moc
#+filetags: :emacs:moc:
The purpose of this file is to store things related to emacs (that being packages, or community projects that i stumble across).
- [[id:034abe27-ca14-4dc0-9a3f-b8d0e1f26342][emacs-stuff-org-roam]] for roam related things
- [[id:8e5e9498-ff3c-48e7-aab5-6e94b2e41ccb][emacs-stuff-gtd]]
- [[id:966175d4-3b58-4abc-9b41-08cbf328dd87][emacs-stuff-keybindings]]
- [[id:7e79e4c5-383d-450f-882c-33d4f87ba1b5][emacs-stuff-elisp]]
- [[id:2ab0fa3f-8ac6-4af2-8cd4-1dd490fb19c3][emacs-stuff-magit]]
- [[id:45CC3AF5-5E20-4B03-A36C-8D4BDD5CBB13][emacs-stuff-evil]]
- A link that contains all the key bindings for emacs: [[http://xahlee.info/emacs/emacs/emacs_keybinding_list.html][Keybindings list]]
- the theme 'ef-dream' repository: [[https://github.com/protesilaos/ef-themes][ef-themes]]
- something to look into: [[https://github.com/mickeynp/combobulate][combobulate]]
- the use package git hub: [[https://github.com/jwiegley/use-package][use-package]]
- hamacs (someones emacs config) [[https://www.howardabrams.com/hamacs/][hamacs]]
- projectile doc [[https://docs.projectile.mx/projectile/configuration.html][proj doc]]
- doom style dashboard [[https://gist.github.com/DevelopmentCool2449/ffc91d1d9b7b16e0f48402b698386f3d#file-dashboard-doom-style-el][doom dash]]
- soft charcoal theme [[https://github.com/mswift42/soft-charcoal-theme?tab=readme-ov-file][sc]]
- the theme im currently using: [[https://github.com/ogdenwebb/emacs-kaolin-themes?tab=readme-ov-file][kaolin]]
- config: [[https://gitlab.com/dwt1/configuring-emacs][config-dwt]]
- simplenote to self hosted: [[https://ru2saig.github.io/posts/switching-from-simplenote-to-a-self-hosted-approach-nextcloud-orgzly-and-emacs/][Link]]

View File

@@ -1,29 +0,0 @@
:PROPERTIES:
:ID: 034abe27-ca14-4dc0-9a3f-b8d0e1f26342
:END:
#+title: emacs-stuff-org-roam
This base will contain information on org roam. Although its closely linked to the [[id:8e5e9498-ff3c-48e7-aab5-6e94b2e41ccb][emacs-stuff-gtd]] node, that one will contain articles, notes and videos related to how to get things done.
Here is the current config in my init.el
#+BEGIN_SRC elisp
;;roam config
(use-package org-roam
:ensure t
:custom
(org-roam-directory "~/master-folder/org_files/org_roam")
:bind (("C-c n l" . org-roam-buffer-toggle)
("C-c n f" . org-roam-node-find)
("C-c n i" . org-roam-node-insert))
:config
(org-roam-setup))
#+END_SRC
- for the org-roam-ui (the graphical interface for nodes): [[https://github.com/org-roam/org-roam-ui][org-roam-ui]]
- an article: [[https://gist.github.com/nickanderson/00005b5b03e323a65ada98c5fa5ebb11][example-org-roam-workflow.org]]
- An article to read: [[https://cmdln.org/2023/03/25/how-i-org-in-2023/][How i use org in 2023]]
- An article: [[https://jethrokuan.github.io/org-roam-guide/][org-roam-guide]]
- An article: [[https://ianjones.info/own-your-second-brain][Own your second brain]]
- article: [[https://honnef.co/articles/my-org-roam-workflows-for-taking-notes-and-writing-articles/][my-org-roam-workflows-for-taking-notes-and-writing-articles]]
- article: [[https://michaelneuper.com/posts/how-i-use-org-roam-to-takes-notes-for-cs/][how-i-use-org-roam-to-takes-notes-for-cs]]

View File

@@ -1,7 +0,0 @@
:PROPERTIES:
:ID: 8e5e9498-ff3c-48e7-aab5-6e94b2e41ccb
:END:
#+title: emacs-stuff-gtd
#+filetags: :emacs:gtd:resources:
- article: [[https://hamberg.no/gtd][gtd]]

View File

@@ -1,27 +0,0 @@
:PROPERTIES:
:ID: 7d199fbe-b0e7-48fd-b8a1-793044dbea01
:END:
#+title: FYP
#+filetags: :index:uni:fyp:
In this file i will include things related to my final year *project*.
- The idea:
*A web platform for users to take notes with an ai assistant*
- Migrating to cloud databse.
I was originally intending to use AWS RDS with an e2c instance, but realised that the learning curve was too great, and that i needed a simpler solution.
On the <2024-12-09 Mon> I decided to try this: exporting the current vm i had running and run in on oracle cloud.
The results for this:
The UML for this project: [[id:4a8edaed-9ebd-402b-9c5f-7a0cb4399102][UML_FYP]]
@startuml
Alice -> Bob: Authentication Request
Bob --> Alice: Authentication Response
Alice -> Bob: Another authentication Request
Alice <-- Bob: Another authentication Response
@enduml
[[id:26b2ed9a-cb81-4c43-bc63-6b3c8ffa3bf1][fyp-report-planning]]

0
20241210152650-uni.org Normal file → Executable file
View File

View File

@@ -1,12 +0,0 @@
:PROPERTIES:
:ID: 797d6e3e-98eb-4bc7-88b6-e096ef7306ad
:END:
#+title: uni_moc
#+filetags: :uni:index:
* Modules:
- [[id:5443ed1c-bb7f-4eb4-9c96-d12648dd2291][tpis]]
- [[id:556d10d1-1c74-4d9f-a398-39cb3bd5d935][afp]]
- [[id:c69e4c4d-2fb4-4cf1-a835-a235cf6db8e9][ise]]
- [[id:3acffb66-bc1a-4661-904f-c5447b3c3488][advanced-networking]]
* Final Year Project
- [[id:7d199fbe-b0e7-48fd-b8a1-793044dbea01][fyp]] Final Year Project

View File

@@ -1,9 +0,0 @@
:PROPERTIES:
:ID: 5443ed1c-bb7f-4eb4-9c96-d12648dd2291
:END:
#+title: TPIS
#+filetags: :uni:tpis:
Teaching Programming In School
- Proposal: [[file:~/master-folder/misc/proposal.pdf][Proposal for the module]]
- <2024-12-10 Tue> - Presentation

View File

@@ -1,708 +0,0 @@
:PROPERTIES:
:ID: 4a8edaed-9ebd-402b-9c5f-7a0cb4399102
:END:
#+title: UML_FYP
#+filetags: :uni:fyp:
* Class diagram
** class 2:
@startuml
skinparam classAttributeIconSize 0
skinparam packageStyle rectangle
skinparam linetype ortho
left to right direction
' Entity Layer
rectangle "Entity Layer" as EntityLayer #E3F2FD {
class User {
+id: Long
+roles: Set<String>
+firstName: String
+lastName: String
+username: String
+password: String
+confirmPassword: String
+email: String
+phoneNumber: String
+picture: byte[]
}
class Workspace {
+id: Long
+name: String
+description: String
+fileCount: int
+noteCount: int
+lastAccessed: LocalDateTime
+dateCreated: LocalDateTime
}
class Library {
+id: Long
+name: String
+description: String
+dateCreated: LocalDateTime
+lastAccessed: LocalDateTime
}
class Page {
+id: Long
+name: String
+workspaceId: Long
+content: Text
+height: int
+width: int
}
class FileMetadata {
+id: Long
+fileUrl: String
+userId: String
+description: String
+fileData: byte[]
+fileName: String
+fileType: String
}
class AiChat {
+id: Long
+name: String
+workspaceId: Long
+createdAt: LocalDateTime
+messages: List<AIChatMessage>
}
}
' Repository Layer
rectangle "Repository Layer" as RepositoryLayer #E8F5E9 {
class AiChatRepository
class FileMetadataRepository
class LibraryRepository
class PageRepository
class UserRepository
class WorkspaceRepository
class RegisterRepository
class AuthRepository
}
' Service Layer
rectangle "Service Layer" as ServiceLayer #FFF3E0 {
class AiChatService
class AuthService
class FileMetadataService
class LibraryService
class PageService
class RegisterService
class UserService
class WorkspaceService
}
' Controller Layer
rectangle "Controller Layer" as ControllerLayer #F3E5F5 {
class AiChatController
class AiChatWebSocketController
class AuthController
class FileMetadataController
class LibraryController
class PageController
class RegisterController
class UserController
class WorkspaceController
}
' External Python Microservice
rectangle "External NLP Module (Python FastAPI)" as ExternalNLP #FCE4EC {
class FastAPINLPServer {
+/extract_text
+/keywords
+/tfidf_keywords
+/summarize
+/ner
}
}
rectangle "Frontend Core" as FrontendCore {
class AboutComponent
class AccessibilityComponent
class ContactComponent
class ForgotPasswordComponent
class LoginComponent
class LoginService
class PrivacyComponent
class RegisterComponent
class RegisterService
class SecurityComponent
class TermsComponent
LoginComponent --> LoginService
RegisterComponent --> RegisterService
LoginService ..> AuthController : REST
RegisterService ..> RegisterController : REST
}
rectangle "Frontend Entities" as FrontendEntities {
class AiChatComponent
class DashboardComponent
class DefaultLayoutComponent
class HomeComponent
class LibraryComponent
class ProfileComponent
class WorkspacePageComponent
class WorkspacesComponent
class AiChatServiceFE
class DashboardServiceFE
class LayoutServiceFE
class HomeServiceFE
class LibraryServiceFE
class ProfileServiceFE
class WorkspacePageServiceFE
class WorkspacesServiceFE
AiChatComponent --> AiChatServiceFE
DashboardComponent --> DashboardServiceFE
DefaultLayoutComponent --> LayoutServiceFE
DefaultLayoutComponent --> LoginComponent
DefaultLayoutComponent --> RegisterComponent
HomeComponent --> HomeServiceFE
LibraryComponent --> LibraryServiceFE
ProfileComponent --> ProfileServiceFE
WorkspacePageComponent --> WorkspacePageServiceFE
WorkspacesComponent --> WorkspacesServiceFE
ForgotPasswordComponent ..> UserController : REST
AiChatServiceFE ..> AiChatController : REST
AiChatServiceFE ..> AiChatWebSocketController : WebSocket
DashboardServiceFE ..> WorkspaceController : REST
DashboardServiceFE ..> PageController : REST
DashboardServiceFE ..> AiChatController : REST
LayoutServiceFE ..> UserController : REST
HomeServiceFE ..> AuthController : REST
LibraryServiceFE ..> LibraryController : REST
LibraryServiceFE ..> FileMetadataController : REST
ProfileServiceFE ..> UserController : REST
WorkspacePageServiceFE ..> PageController : REST
WorkspacePageServiceFE ..> FileMetadataController : REST
WorkspacePageServiceFE ..> AiChatController : REST
WorkspacesServiceFE ..> WorkspaceController : REST
AboutComponent --> ContactComponent
AboutComponent --> TermsComponent
AboutComponent --> PrivacyComponent
}
class AngularClient
AngularClient --> FrontendCore
AngularClient --> FrontendEntities
AngularClient ..> FastAPINLPServer : REST
' Entity Relationships
User "1" --> "many" Library
User "1" --> "many" Workspace
Library "1" --> "many" Workspace
Library "1" --> "many" FileMetadata
Workspace "1" --> "many" Page
Workspace "1" --> "many" FileMetadata
Workspace "1" --> "many" AiChat
' Controller → Service
AiChatController --> AiChatService
AiChatWebSocketController --> AiChatService
AuthController --> AuthService
FileMetadataController --> FileMetadataService
LibraryController --> LibraryService
PageController --> PageService
RegisterController --> RegisterService
UserController --> UserService
WorkspaceController --> WorkspaceService
' Service → Repository
AiChatService --> AiChatRepository
AuthService --> AuthRepository
FileMetadataService --> FileMetadataRepository
LibraryService --> LibraryRepository
PageService --> PageRepository
RegisterService --> RegisterRepository
UserService --> UserRepository
WorkspaceService --> WorkspaceRepository
' Repository → Entity
AiChatRepository --> AiChat
FileMetadataRepository --> FileMetadata
LibraryRepository --> Library
PageRepository --> Page
UserRepository --> User
WorkspaceRepository --> Workspace
RegisterRepository --> User
AuthRepository --> User
@enduml
** authentication sequence diagram:
@startuml
title Full Authentication Flow - Registration to Secured Access
skinparam shadowing true
skinparam packageStyle rectangle
skinparam handwritten false
skinparam linetype polyline
skinparam ParticipantPadding 20
skinparam maxMessageSize 150
actor User
== Registration Process ==
box "Client" #E3F2FD
participant UserClient as "User"
end box
box "Backend - Registration" #E8F5E9
participant RegisterController
participant UserService
end box
UserClient -> RegisterController : POST /register\n(username, password, confirmPassword)
RegisterController -> RegisterController : Check if passwords match
alt Passwords do not match
RegisterController --> UserClient : 400 Bad Request (Passwords mismatch)
return
end
RegisterController -> RegisterController : Hash password (BCrypt)
RegisterController -> RegisterController : Load default profile image
RegisterController -> UserService : createUser(user)
RegisterController --> UserClient : 200 OK (User Created)
== Authentication Process ==
box "Backend - Authentication" #FFF3E0
participant AuthController
participant AuthenticationManager
participant JwtUtil
end box
UserClient -> AuthController : POST /auth/login\n(username, password)
AuthController -> AuthenticationManager : Authenticate credentials
alt Valid credentials
AuthController -> JwtUtil : generateToken(userDetails, userId)
AuthController --> UserClient : 200 OK + JWT
else Invalid credentials
AuthController --> UserClient : 401 Unauthorized
return
end
== Accessing a Protected API ==
box "Security Filter Chain" #F3E5F5
participant JwtRequestFilter
participant UserDetailsService
participant JwtUtilFilter as "JwtUtil"
end box
UserClient -> JwtRequestFilter : Request with Authorization header
JwtRequestFilter -> JwtUtilFilter : extractUsername(jwt)
JwtRequestFilter -> UserDetailsService : loadUserByUsername
JwtRequestFilter -> JwtUtilFilter : validateToken(jwt, userDetails)
alt Valid token
JwtRequestFilter -> SecurityContext : Set authentication
else Invalid token
JwtRequestFilter -> JwtRequestFilter : Log and skip authentication
end
JwtRequestFilter --> UserClient : Continue filter chain
== @JwtRequired Secured Method Access ==
box "AOP - Method Security" #E1F5FE
participant JwtAspect
participant JwtUtilAspect as "JwtUtil"
end box
UserClient -> JwtAspect : Call method annotated with @JwtRequired
JwtAspect -> JwtAspect : Extract JWT from header
JwtAspect -> JwtUtilAspect : extractUsername(jwt)
JwtAspect -> SecurityContext : Get UserDetails
JwtAspect -> JwtUtilAspect : validateToken(jwt, userDetails)
alt Token valid and user matches
JwtAspect --> UserClient : Proceed to method execution
else Invalid/mismatched token
JwtAspect --> UserClient : Unauthorized exception
return
end
@enduml
** class
@startuml
skinparam classAttributeIconSize 0
skinparam packageStyle rectangle
package "High-Level Overview" {
' Controller Layer
package "Controller Layer" {
class AiChatController
class AiChatWebSocketController
class AuthController
class FileMetadataController
class LibraryController
class PageController
class RegisterController
class UserController
class WorkspaceController
}
' Service Layer
package "Service Layer" {
class AiChatService
class AuthService
class FileMetadataService
class LibraryService
class PageService
class RegisterService
class UserService
class WorkspaceService
}
' Repository Layer
package "Repository Layer" {
class AiChatRepository
class FileMetadataRepository
class LibraryRepository
class PageRepository
class UserRepository
class WorkspaceRepository
class RegisterRepository
class AuthRepository
}
' Entity Layer
package "Entity Layer" {
class User {
+id: Long
+roles: Set<String>
+firstName: String
+lastName: String
+username: String
+password: String
+confirmPassword: String
+email: String
+phoneNumber: String
+picture: byte[]
}
class Workspace {
+id: Long
+name: String
+description: String
+fileCount: int
+noteCount: int
+lastAccessed: LocalDateTime
+dateCreated: LocalDateTime
}
class Library {
+id: Long
+name: String
+description: String
+dateCreated: LocalDateTime
+lastAccessed: LocalDateTime
}
class Page {
+id: Long
+name: String
+workspaceId: Long
+content: Text
+height: int
+width: int
}
class FileMetadata {
+id: Long
+fileUrl: String
+userId: String
+description: String
+fileData: byte[]
+fileName: String
+fileType: String
}
class AiChat {
+id: Long
+name: String
+workspaceId: Long
+createdAt: LocalDateTime
+messages: List<AIChatMessage>
}
}
' Python NLP Microservice
package "External NLP Module (Python FastAPI)" {
class FastAPINLPServer {
+/extract_text
+/keywords
+/tfidf_keywords
+/summarize
+/ner
}
}
' Entity Relationships
User "1" --> "many" Library
User "1" --> "many" Workspace
Library "1" --> "many" Workspace
Library "1" --> "many" FileMetadata
Workspace "1" --> "many" Page
Workspace "1" --> "many" FileMetadata
Workspace "1" --> "many" AiChat
' Controller → Service
AiChatController --> AiChatService
AiChatWebSocketController --> AiChatService
AuthController --> AuthService
FileMetadataController --> FileMetadataService
LibraryController --> LibraryService
PageController --> PageService
RegisterController --> RegisterService
UserController --> UserService
WorkspaceController --> WorkspaceService
' Service → Repository
AiChatService --> AiChatRepository
AuthService --> AuthRepository
FileMetadataService --> FileMetadataRepository
LibraryService --> LibraryRepository
PageService --> PageRepository
RegisterService --> RegisterRepository
UserService --> UserRepository
WorkspaceService --> WorkspaceRepository
' Repository → Entity
AiChatRepository --> AiChat
FileMetadataRepository --> FileMetadata
LibraryRepository --> Library
PageRepository --> Page
UserRepository --> User
WorkspaceRepository --> Workspace
RegisterRepository --> User
AuthRepository --> User
' Frontend → NLP Server
}
' Frontend Component
package "Frontend" {
class AngularClient
}
' Angular communicates with both backends
AngularClient ..> AiChatController : REST
AngularClient ..> AiChatWebSocketController : WebSocket
AngularClient ..> AuthController : REST
AngularClient ..> PageController : REST
AngularClient ..> FileMetadataController : REST
AngularClient ..> WorkspaceController : REST
AngularClient ..> LibraryController : REST
AngularClient ..> RegisterController : REST
AngularClient ..> UserController : REST
AngularClient ..> FastAPINLPServer : REST
@enduml
** client-server
@startuml
!pragma layout smetana
actor User
package "Client Side (Angular)" {
[Angular App] as Frontend
}
package "Spring Boot Backend" {
[Auth Controller]
[Note Controller]
[NLP Proxy Service]
[Spring Boot App] as Backend
}
package "Database Layer" {
database "PostgreSQL Database" as DB
}
package "FastAPI NLP Server (Port 9010)" {
[FastAPI NLP Service] as NLP
[Summarisation Endpoint] as SumEndpoint
[Keyword Extraction] as KeywordEndpoint
[NER Endpoint] as NEREndpoint
}
package "External API" {
[OpenAI API]
}
' Interactions
User --> Frontend : Uses Web Interface
Frontend --> Backend : REST API Calls
Backend --> [Auth Controller] : Handles Auth
Backend --> [Note Controller] : Handles Notes
Backend --> [NLP Proxy Service] : Handles NLP Requests
[Auth Controller] --> DB : Access users table
[Note Controller] --> DB : Access notes table
[NLP Proxy Service] --> NLP : HTTP (port 9010)
NLP --> SumEndpoint : /summarise
NLP --> KeywordEndpoint : /keywords
NLP --> NEREndpoint : /ner
SumEndpoint --> [OpenAI API] : API call for contextual help
note right of Frontend
Angular app includes:
- Note Editor
- Summary View
- Keyword Panel
end note
note right of Backend
Spring Boot includes:
- Auth Controller
- Note Controller
- NLP Proxy Service (calls FastAPI)
end note
note right of NLP
FastAPI exposes endpoints for:
- Summarisation (Pegasus)
- Keyword Extraction (TF-IDF, YAKE)
- NER (spaCy)
end note
@enduml
** high level:
@startuml
skinparam componentStyle uml2
skinparam packageStyle rectangle
package "Client (Frontend)" {
[Angular UI]
}
package "Java Backend (Spring Boot)" {
[REST API Controller Layer]
[WebSocket Controller]
[Service Layer]
[Repository Layer]
[JPA Entities]
}
package "Python NLP Service" {
[FastAPI Server]
[Summarizer (Pegasus)]
[Keyword Extractor (YAKE / TF-IDF)]
[NER (spaCy)]
[Extract Text (Canvas Object)]
}
package "External Services" {
[OpenAI API]
[PostgreSQL DB]
}
' Communication Arrows
[Angular UI] --> [REST API Controller Layer] : REST API (JSON)
[Angular UI] --> [WebSocket Controller] : WebSocket
[REST API Controller Layer] --> [Service Layer]
[WebSocket Controller] --> [Service Layer]
[Service Layer] --> [Repository Layer]
[Repository Layer] ..> [JPA Entities] : uses
[Service Layer] --> [OpenAI API] : API calls
[Service Layer] --> [FastAPI Server] : REST (NLP Requests)
[FastAPI Server] --> [Summarizer (Pegasus)]
[FastAPI Server] --> [Keyword Extractor (YAKE / TF-IDF)]
[FastAPI Server] --> [NER (spaCy)]
[FastAPI Server] --> [Extract Text (Canvas Object)]
[Repository Layer] --> [PostgreSQL DB] : Hibernate ORM
@enduml
** title AI Chat + Workspace Workflow
@startuml
title AI Chat + Workspace Workflow
skinparam shadowing true
skinparam packageStyle rectangle
skinparam handwritten false
skinparam linetype polyline
skinparam ParticipantPadding 20
skinparam maxMessageSize 150
actor User
== AI Chat Session Creation ==
box "Client" #E3F2FD
participant AngularClient as "User"
end box
box "Backend - AI Chat" #E8F5E9
participant AiChatController
participant AiChatService
participant AiChatRepository
end box
box "External NLP Service" #FCE4EC
participant FastAPINLPServer as "FastAPI NLP"
end box
User -> AngularClient : Open AI Chat page
AngularClient -> AiChatController : POST /ai-chat\n(chat metadata)
AiChatController -> AiChatService : createChat(chatDto)
AiChatService -> AiChatRepository : save(chat)
AiChatService --> AiChatController : chatId
AiChatController --> AngularClient : 200 OK + chatId
User -> AngularClient : Send message via WebSocket
AngularClient -> AiChatWebSocketController : message
AiChatWebSocketController -> AiChatService : handleMessage()
alt Message requires NLP
AiChatService -> FastAPINLPServer : POST /summarize or /ner
FastAPINLPServer --> AiChatService : NLP result
end
AiChatService -> AiChatRepository : update(chat with message)
AiChatWebSocketController --> AngularClient : Message response
== Workspace Creation ==
box "Backend - Workspace" #FFF3E0
participant WorkspaceController
participant WorkspaceService
participant WorkspaceRepository
end box
User -> AngularClient : Create Workspace
AngularClient -> WorkspaceController : POST /workspace\n(name, description)
WorkspaceController -> WorkspaceService : createWorkspace(dto)
WorkspaceService -> WorkspaceRepository : save(workspace)
WorkspaceService --> WorkspaceController : workspaceId
WorkspaceController --> AngularClient : 200 OK + workspaceId
@enduml
* Screenshots:
** Draft 1:
[[file:~/master-folder/FYP/uml/draft1.png]]

View File

@@ -1,34 +0,0 @@
:PROPERTIES:
:ID: b2fb976a-c23c-4275-8a53-da343c223b97
:END:
#+title: brain
#+filetags: :brain:
#+BEGIN_SRC elisp
(org-roam-ui-mode)
#+END_SRC
#+RESULTS:
: t
* Technical (Computing)
[[id:8fa3f476-6152-45f4-b618-50f1e4bce46c][Emacs Stuff]]
[[id:2f285f04-fcf4-4ade-a1ac-2c50b43d529a][technical]]
* Career
** Work
*** Index: [[id:dd04d228-fff5-402a-929d-9d113a2ec965][career-index]]
** Applications - career (pre work)
The org file: [[file:~/master-folder/org_files/career.org][career]]
The roam file: [[id:fe5086b8-1941-4125-881a-65d01e1e7774][Career roam]]
* Uni stuff:
[[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][Uni]]
* Misc
** Books
[[id:63314cff-3a3f-49b4-9e76-4a359c51f55f][books-main]]
[[id:2706598f-e6aa-4e88-8d24-5f699bd22787][Book Notes]]
** Food
[[id:65F747B1-3CB2-429A-9E26-ED8BC169E689][recipes-main]]

View File

@@ -1,30 +1,25 @@
:PROPERTIES:
:ID: b2fb976a-c23c-4275-8a53-da343c223b97
:END:
#+title: brain_moc
#+title: Brain MOC
#+filetags: :moc:
#+BEGIN_SRC elisp
(org-roam-ui-mode)
#+END_SRC
* [[id:580cc3a5-af8e-4cbe-b5ad-5b06680e6c37][Backlog]]
* [[id:2f285f04-fcf4-4ade-a1ac-2c50b43d529a][Technical MOC]]
* [[id:565eaccd-8cf6-4dbb-bc66-a4b37367ce6b][Non Technical MOC]]
* [[id:dd04d228-fff5-402a-929d-9d113a2ec965][Career MOC]]
* [[id:08415f5c-986e-45a6-8ea1-f3bedcc996f0][Misc MOC]]
* [[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][Uni MOC]]
#+RESULTS:
: t
* Backlog
[[id:580cc3a5-af8e-4cbe-b5ad-5b06680e6c37][backlog]]
* Technical (Computing)
[[id:2f285f04-fcf4-4ade-a1ac-2c50b43d529a][technical_moc]]
* Non Technical
[[id:565eaccd-8cf6-4dbb-bc66-a4b37367ce6b][non_technical_moc]]
* Uni stuff:
[[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][uni_moc]]
* Career
[[id:dd04d228-fff5-402a-929d-9d113a2ec965][career_moc]]
* Misc
[[id:08415f5c-986e-45a6-8ea1-f3bedcc996f0][misc_moc]]

View File

@@ -1,32 +0,0 @@
:PROPERTIES:
:ID: b2fb976a-c23c-4275-8a53-da343c223b97
:END:
#+title: brain_moc
#+filetags: :moc:
#+BEGIN_SRC elisp
(org-roam-ui-mode)
#+END_SRC
#+RESULTS:
: t
* Technical (Computing)
[[id:2f285f04-fcf4-4ade-a1ac-2c50b43d529a][technical_moc]]
* Non Technical
[[id:565eaccd-8cf6-4dbb-bc66-a4b37367ce6b][non_technical_moc]]
* Uni stuff:
[[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][uni_moc]]
* Career
[[id:dd04d228-fff5-402a-929d-9d113a2ec965][career_moc]]
* Misc
[[id:08415f5c-986e-45a6-8ea1-f3bedcc996f0][misc_moc]]
* quick notes
** portainer access token:
ptr_KFQqKse9K4Nc9M5jnpc61fpAvGzdTOXTzswz9CwOF74=

0
20241211161232-applications.org Normal file → Executable file
View File

View File

@@ -1,9 +0,0 @@
:PROPERTIES:
:ID: fe5086b8-1941-4125-881a-65d01e1e7774
:END:
#+title: Career roam
#+filetags: :pre-career:index:
Microlise Assessment Centre: [[id:f877240e-c2c8-4087-84e5-4b1ca3fcd4ed][microlise-assessment]]

View File

@@ -1,54 +0,0 @@
:PROPERTIES:
:ID: 347d2663-515b-4d9a-9ee9-7706ee86a845
:END:
#+title: Haskell Notes
#+filetags: :technical:notes:haskell:coding:
* Haskell Notes
** Introduction
Haskell is a purely functional programming language with strong [[id:729441d1-51d5-4d94-8fe6-ff9ebb3f5739][Static Typing]] and [[id:63456626-b34e-46d9-b85e-0f1f5724aa83][Lazy Evaluation]]. It was named after the logician Haskell Curry. It is widely used in academia and industry for teaching and research as well as for writing industrial applications.
** Features of Haskell
- Purely Functional: Functions in Haskell are pure, meaning they don't have side effects.
- Strong Static Typing: Types are checked at compile time, reducing runtime errors.
- Lazy Evaluation: Expressions are not evaluated until their values are needed.
- Type Inference: Haskell can automatically infer types, making the code more concise.
- Concise Syntax: Haskell's syntax is clean and concise, making it easy to read and write.
** Getting Started with Haskell
- Installation: To get started with Haskell, you need to install the Glasgow Haskell Compiler (GHC). You can download it from [[https://www.haskell.org/downloads/][Download]]
- Basic Syntax:
- Comments: Single line comments start with `--`, and multi-line comments are enclosed within `{-` and `-}`.
- Modules: Code is organized into modules, which can be imported using the `import` keyword.
** Basic Concepts
- Functions: Functions are first-class citizens in Haskell. A function definition looks like this:
#+BEGIN_SRC haskell
add :: Int -> Int -> Int
add x y = x + y
#+END_SRC
This defines a function *add* that takes two integers and returns their sum.
- Types and Type Classes: Types are a crucial part of Haskell. You define types using the `data` keyword, and type classes using the `class` keyword.
** Example
Here's a simple example to demonstrate some basic features of Haskell:
#+BEGIN_SRC haskell
-- Define a new data type
data Shape = Circle Float | Rectangle Float Float
-- Define a function to calculate the area of a shape
area :: Shape -> Float
area (Circle r) = pi * r^2
area (Rectangle l w) = l * w
-- Example usage
main = do
let c = Circle 10
let r = Rectangle 5 7
print (area c)
print (area r)
#+END_SRC
This example defines a new data type Shape with two constructors, Circle and Rectangle, and a function area that calculates the area of a shape.

View File

@@ -1,9 +0,0 @@
:PROPERTIES:
:ID: 63456626-b34e-46d9-b85e-0f1f5724aa83
:END:
#+title: Lazy Evaluation
#+filetags: :haskell:coding:notes:
See this article: [[https://medium.com/background-thread/what-is-lazy-evaluation-programming-word-of-the-day-8a6f4410053f][Lazy eval]]
There are two types of evaluation: strict and lazy

View File

@@ -1,7 +0,0 @@
:PROPERTIES:
:ID: 5a207a1c-6f02-40d5-b42e-38daaa0aec10
:END:
#+title: c_notes
#+filetags: :index:coding:notes:
[[id:efe0360d-8d81-4372-833d-ad58e67d17c6][socket_programming_in_c]]

Some files were not shown because too many files have changed in this diff Show More