daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

pkg update and first config fix

Browse Source 
org-brain not working, add org-roam
This commit is contained in:
Daniel Weschke
2022-12-19 23:02:34 +01:00
parent 02b3e07185
commit 82f05baffe
885 changed files with 356098 additions and 36993 deletions
Download Patch File Download Diff File Expand all files Collapse all files

435
lisp/emacsql/README.md Normal file
View File

@@ -0,0 +1,435 @@
# EmacSQL
EmacSQL is a high-level Emacs Lisp front-end for SQLite (primarily),
PostgreSQL, MySQL, and potentially other SQL databases.
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.
On MELPA, each back-end is provided as a separate package, suffixed with
the database name. In the case of `emacsql-sqlite`, on first use EmacSQL
will attempt to find a C compiler and use it to compile a custom native
binary for communicating with a SQLite database.
Requires Emacs 25 or later.
### 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 "~/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]
```
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.
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.
## 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.
## SQLite Support
The custom EmacSQL SQLite binary is compiled with [Soundex][soundex] and
[full-text search][fts] (FTS3, FTS4, and FTS5) enabled -- features
disabled by the default SQLite build. This back-end should work on any
system with a conforming ANSI C compiler installed under a command name
listed in `emacsql-sqlite-c-compilers`.
### 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 `finalize` packages into
sibling directories. The Makefile will automatically put these paths on
the Emacs load path (override `LDFLAGS` if your situation is different).
$ cd ..
$ git clone https://github.com/cbbrowne/pg.el pg
$ git clone https://github.com/skeeto/elisp-finalize finalize
$ cd -
Then invoke make:
$ 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
[stderr]: http://thread.gmane.org/gmane.comp.db.sqlite.general/85824
[foreign]: http://www.sqlite.org/foreignkeys.html
[batch]: http://lists.gnu.org/archive/html/emacs-pretest-bug/2005-11/msg00320.html
[fts]: http://www.sqlite.org/fts3.html
[soundex]: http://www.sqlite.org/compile.html#soundex
[mistake]: https://github.com/magit/emacsql/issues/35#issuecomment-346352439
<!-- LocalWords: EIEIO Elisp EmacSQL FTS MELPA Makefile NOCASE RTRIM SQL's Soundex -->
<!-- LocalWords: autocommit el emacsql mixin psql schemas unprinted whitespace -->

542
lisp/emacsql/emacsql-compiler.el Normal file
View File

@@ -0,0 +1,542 @@
;;; emacsql-compile.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 <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; SPDX-License-Identifier: Unlicense
;;; Code:
(require 'cl-lib)
;;; 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
(setf (get ',symbol 'error-conditions) ',conditions
(get ',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 expresson."
(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)."
(when (symbolp thing)
(let ((name (symbol-name thing)))
(when (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)
(setf 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."
(when 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))
(setf 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
(setf 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 (setf last item)
finally (cl-return
(mapconcat #'identity 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-compile.el ends here

10
lisp/emacsql/emacsql-pkg.el Normal file
View File

@@ -0,0 +1,10 @@
(define-package "emacsql" "20221127.2146" "High-level SQL database front-end"
'((emacs "25.1"))
:commit "6b2e65bdf785364cf7c34c31fea5812e1e58c657" :authors
'(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
:url "https://github.com/magit/emacsql")
;; Local Variables:
;; no-byte-compile: t
;; End:

477
lisp/emacsql/emacsql.el Normal file
View File

@@ -0,0 +1,477 @@
;;; 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 <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; EmacSQL is a high-level Emacs Lisp front-end for SQLite
;; (primarily), PostgreSQL, MySQL, and potentially other SQL
;; databases. On MELPA, each of the backends is provided through
;; separate packages: emacsql-sqlite, emacsql-psql, emacsql-mysql.
;; Most EmacSQL functions operate on a database connection. For
;; example, a connection to SQLite is established with
;; `emacsql-sqlite'. For each such connection a sqlite3 inferior
;; process is kept alive in the background. Connections are closed
;; with `emacsql-close'.
;; (defvar db (emacsql-sqlite "company.db"))
;; Use `emacsql' to send an s-expression SQL statements to a connected
;; database. Identifiers for tables and columns are symbols. SQL
;; keywords are lisp keywords. Anything else is data.
;; (emacsql db [:create-table people ([name id salary])])
;; Column constraints can optionally be provided in the schema.
;; (emacsql db [:create-table people ([name (id integer :unique) salary])])
;; Insert some values.
;; (emacsql db [:insert :into people
;; :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])])
;; Currently all actions are synchronous and Emacs will block until
;; SQLite has indicated it is finished processing the last command.
;; Query the database for results:
;; (emacsql db [:select [name id] :from employees :where (> salary 60000)])
;; ;; => (("Susan" 1001))
;; Queries can be templates -- $i1, $s2, etc. -- so they don't need to
;; be built up dynamically:
;; (emacsql db
;; [:select [name id] :from employees :where (> salary $s1)]
;; 50000)
;; ;; => (("Jeff" 1000) ("Susan" 1001))
;; The letter declares the type (identifier, scalar, vector, Schema)
;; and the number declares the argument position.
;; 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 "3.1.1.50-git")
(defvar emacsql-global-timeout 30
"Maximum number of seconds to wait before bailing out on a SQL command.
If nil, wait forever.")
(defvar emacsql-data-root
(file-name-directory (or load-file-name buffer-file-name))
"Directory where EmacSQL is installed.")
;;; Database connection
(defclass emacsql-connection ()
((process :initarg :process
:accessor emacsql-process)
(log-buffer :type (or null buffer)
:initarg :log-buffer
:initform nil
:accessor emacsql-log-buffer
: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."))
(:documentation "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."
(not (null (process-live-p (emacsql-process connection)))))
(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 (emacsql-process connection)))
(cl-defmethod emacsql-enable-debugging ((connection emacsql-connection))
"Enable debugging on CONNECTION."
(unless (buffer-live-p (emacsql-log-buffer connection))
(setf (emacsql-log-buffer connection)
(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 (emacsql-log-buffer connection)))
(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 process 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 (when 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 (emacsql-process connection) 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* ((mask (when connection (emacsql-types connection)))
(emacsql-type-map (or mask 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 ()
()
(:documentation
"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 true if the end of the buffer has a properly-formatted prompt."
(with-current-buffer (emacsql-buffer connection)
(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 (eql value 'error)
(emacsql-handle connection (read) (read))
(prog1 value
(unless (eq 'success (read))
(emacsql-handle connection (read) (read))))))))
(provide 'emacsql) ; end of generic function declarations
;;; Automatic connection cleanup
(defun emacsql-register (connection)
"Register CONNECTION for automatic cleanup and return CONNECTION."
(let ((finalizer (make-finalizer (lambda () (emacsql-close connection)))))
(prog1 connection
(setf (slot-value connection 'finalizer) finalizer))))
;;; 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)))
(setf emacsql--result result)
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:commit]))
(setf 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 (unless (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)
(setf 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))
(if (and (fboundp 'font-lock-flush)
(fboundp 'font-lock-ensure))
(save-restriction
(widen)
(font-lock-flush)
(font-lock-ensure))
(with-no-warnings
(font-lock-fontify-buffer)))
(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))))
;;; Common SQLite values
(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.")
;;; 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)))
(when containing-sexp
(goto-char containing-sexp)
(looking-at "\\["))))))
(defadvice calculate-lisp-indent (around emacsql-vector-indent disable)
"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))
ad-do-it)
ad-do-it))
(defun emacsql-fix-vector-indentation ()
"When called, advise `calculate-lisp-indent' to stop indenting vectors.
Once activate, vector contents no longer indent like lists."
(interactive)
(ad-enable-advice 'calculate-lisp-indent 'around 'emacsql-vector-indent)
(ad-activate 'calculate-lisp-indent))
;;; emacsql.el ends here