Compare commits
10 Commits
19ecc30a06
...
5562f63bca
| Author | SHA1 | Date | |
|---|---|---|---|
| 5562f63bca | |||
| 53f279f7d6 | |||
| edbbabcf78 | |||
| d98baea05c | |||
| 7ae5ba7684 | |||
| 07e26cd380 | |||
| 3739380ab8 | |||
| 6e13e90e7d | |||
| 80101cd34b | |||
| f217e8828f |
5
.gitignore
vendored
5
.gitignore
vendored
@@ -1 +1,4 @@
|
|||||||
output/
|
output/
|
||||||
|
.packages/
|
||||||
|
.DS_Store
|
||||||
|
backups/
|
||||||
File diff suppressed because it is too large
Load Diff
@@ -1 +0,0 @@
|
|||||||
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
@@ -1,28 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,8 +0,0 @@
|
|||||||
;; -*- 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"))
|
|
||||||
@@ -1,534 +0,0 @@
|
|||||||
;;; 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.
@@ -1,83 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,10 +0,0 @@
|
|||||||
;; -*- 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
@@ -1,18 +0,0 @@
|
|||||||
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.
|
|
||||||
@@ -1,434 +0,0 @@
|
|||||||
# 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.
|
|
||||||
|
|
||||||
[](https://github.com/magit/emacsql/actions/workflows/compile.yml)
|
|
||||||
[](https://github.com/magit/emacsql/actions/workflows/test.yml)
|
|
||||||
[](https://elpa.nongnu.org/nongnu-devel/emacsql.html)
|
|
||||||
[](https://stable.melpa.org/#/emacsql)
|
|
||||||
[](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 -->
|
|
||||||
@@ -1,68 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,546 +0,0 @@
|
|||||||
;;; 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.
@@ -1,132 +0,0 @@
|
|||||||
;;; 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.
@@ -1,80 +0,0 @@
|
|||||||
;;; 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.
@@ -1,9 +0,0 @@
|
|||||||
;; -*- 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")))
|
|
||||||
@@ -1,145 +0,0 @@
|
|||||||
;;; 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.
@@ -1,87 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
Binary file not shown.
@@ -1,97 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
Binary file not shown.
@@ -1,296 +0,0 @@
|
|||||||
;;; 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.
@@ -1,384 +0,0 @@
|
|||||||
;;; 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.
@@ -1,6 +0,0 @@
|
|||||||
((nil
|
|
||||||
(indent-tabs-mode . nil))
|
|
||||||
(makefile-mode
|
|
||||||
(indent-tabs-mode . t))
|
|
||||||
(git-commit-mode
|
|
||||||
(git-commit-major-mode . git-commit-elisp-text-mode)))
|
|
||||||
@@ -1,112 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,9 +0,0 @@
|
|||||||
;; -*- 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"))
|
|
||||||
@@ -1,572 +0,0 @@
|
|||||||
;;; 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.
@@ -1,19 +0,0 @@
|
|||||||
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.
|
|
||||||
@@ -1,67 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,14 +0,0 @@
|
|||||||
;; -*- 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.
@@ -1,320 +0,0 @@
|
|||||||
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 don’t 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 section’s
|
|
||||||
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 Git’s output and Git didn’t 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 isn’t 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 isn’t 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 section’s class is the same as the
|
|
||||||
first CLASS or a subclass of that; the section’s 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 section’s 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:
|
|
||||||
@@ -1,18 +0,0 @@
|
|||||||
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.
|
|
||||||
@@ -1,331 +0,0 @@
|
|||||||
;;; 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
|
|
||||||
@@ -1,843 +0,0 @@
|
|||||||
;;; 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.
@@ -1,255 +0,0 @@
|
|||||||
;;; 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.
@@ -1,366 +0,0 @@
|
|||||||
;;; 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.
@@ -1,730 +0,0 @@
|
|||||||
;;; 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.
@@ -1,74 +0,0 @@
|
|||||||
;;; 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.
@@ -1,301 +0,0 @@
|
|||||||
;;; 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.
@@ -1,88 +0,0 @@
|
|||||||
;;; 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.
@@ -1,47 +0,0 @@
|
|||||||
;;; 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.
@@ -1,162 +0,0 @@
|
|||||||
;;; 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.
@@ -1,722 +0,0 @@
|
|||||||
;;; 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.
@@ -1,95 +0,0 @@
|
|||||||
;;; 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.
@@ -1,15 +0,0 @@
|
|||||||
;; -*- 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")))
|
|
||||||
@@ -1,173 +0,0 @@
|
|||||||
;;; 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.
@@ -1,442 +0,0 @@
|
|||||||
;;; 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.
@@ -1,364 +0,0 @@
|
|||||||
;;; 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
0
20241210001045-technical.org
Executable file → Normal file
0
20241210001045-technical.org
Executable file → Normal file
1
20241210001045-technical_moc.org
Executable file → Normal file
1
20241210001045-technical_moc.org
Executable file → Normal file
@@ -14,3 +14,4 @@ In this file I want to include technical coding information. This will include t
|
|||||||
- [[id:ae343652-96fe-4341-8a36-ec3a1abd0dc6][technical-java-notes]]
|
- [[id:ae343652-96fe-4341-8a36-ec3a1abd0dc6][technical-java-notes]]
|
||||||
- [[id:bdb493df-db92-4c93-9558-0b10fdff3048][linux_moc]]
|
- [[id:bdb493df-db92-4c93-9558-0b10fdff3048][linux_moc]]
|
||||||
- [[id:e448cd99-afee-4702-947f-644bb34dc1aa][database_moc]]
|
- [[id:e448cd99-afee-4702-947f-644bb34dc1aa][database_moc]]
|
||||||
|
- [[id:F32F8F09-3DEC-4FD1-8CFA-401A316E906B][xor]]
|
||||||
|
|||||||
0
20241210001150-aoc_notes.org
Executable file → Normal file
0
20241210001150-aoc_notes.org
Executable file → Normal file
0
20241210001206-leetcode_notes.org
Executable file → Normal file
0
20241210001206-leetcode_notes.org
Executable file → Normal file
0
20241210004247-emacs_moc.org
Executable file → Normal file
0
20241210004247-emacs_moc.org
Executable file → Normal file
0
20241210004247-emacs_stuff.org
Executable file → Normal file
0
20241210004247-emacs_stuff.org
Executable file → Normal file
0
20241210004329-org_roam.org
Executable file → Normal file
0
20241210004329-org_roam.org
Executable file → Normal file
0
20241210004453-gtd.org
Executable file → Normal file
0
20241210004453-gtd.org
Executable file → Normal file
0
20241210012703-fyp.org
Executable file → Normal file
0
20241210012703-fyp.org
Executable file → Normal file
0
20241210152650-uni.org
Executable file → Normal file
0
20241210152650-uni.org
Executable file → Normal file
0
20241210152650-uni_moc.org
Executable file → Normal file
0
20241210152650-uni_moc.org
Executable file → Normal file
0
20241210152713-tpis.org
Executable file → Normal file
0
20241210152713-tpis.org
Executable file → Normal file
0
20241210232054-uml_fyp.org
Executable file → Normal file
0
20241210232054-uml_fyp.org
Executable file → Normal file
7
20241210233721-brain_moc.org
Executable file → Normal file
7
20241210233721-brain_moc.org
Executable file → Normal file
@@ -16,10 +16,3 @@
|
|||||||
|
|
||||||
* [[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][Uni MOC]]
|
* [[id:797d6e3e-98eb-4bc7-88b6-e096ef7306ad][Uni MOC]]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
0
20241211161232- job_application_cover_letters.org
Executable file → Normal file
0
20241211161232- job_application_cover_letters.org
Executable file → Normal file
0
20241211161232-applications.org
Executable file → Normal file
0
20241211161232-applications.org
Executable file → Normal file
0
20241212013207-haskell_notes.org
Executable file → Normal file
0
20241212013207-haskell_notes.org
Executable file → Normal file
0
20241212013902-lazy_evaluation.org
Executable file → Normal file
0
20241212013902-lazy_evaluation.org
Executable file → Normal file
0
20241213005125-c_notes.org
Executable file → Normal file
0
20241213005125-c_notes.org
Executable file → Normal file
0
20241213005156-socket_programming_in_c.org
Executable file → Normal file
0
20241213005156-socket_programming_in_c.org
Executable file → Normal file
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user