BUGBUG
#+begin_src sql emacs-lisp :tangle no
- (add-to-list 'load-path "~/.emacs.d/elpa/emacsql-20241201.1551")
+ (add-to-list 'load-path "~/.emacs.d/elpa/emacsql-20250401.1500")
(require 'emacsql)
(add-to-list 'load-path "~/.emacs.d/elpa/emacsql-sqlite-20230225.2205")
+++ /dev/null
-# 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]
-```
-
-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.
-
-### 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 -->
+++ /dev/null
-;;; 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)))
-
-
-\f
-;;; 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-"))
-
-\f
-;;; Generated autoloads from emacsql-compiler.el
-
-(register-definition-prefixes "emacsql-compiler" '("emacsql-"))
-
-\f
-;;; Generated autoloads from emacsql-mysql.el
-
-(register-definition-prefixes "emacsql-mysql" '("emacsql-mysql-"))
-
-\f
-;;; Generated autoloads from emacsql-pg.el
-
-(register-definition-prefixes "emacsql-pg" '("emacsql-pg-connection"))
-
-\f
-;;; Generated autoloads from emacsql-psql.el
-
-(register-definition-prefixes "emacsql-psql" '("emacsql-psql-"))
-
-\f
-;;; Generated autoloads from emacsql-sqlite.el
-
-(register-definition-prefixes "emacsql-sqlite" '("emacsql-"))
-
-\f
-;;; Generated autoloads from emacsql-sqlite-builtin.el
-
-(register-definition-prefixes "emacsql-sqlite-builtin" '("emacsql-sqlite-builtin-connection"))
-
-\f
-;;; Generated autoloads from emacsql-sqlite-module.el
-
-(register-definition-prefixes "emacsql-sqlite-module" '("emacsql-sqlite-module-connection"))
-\f
-;;; 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
+++ /dev/null
-;;; emacsql-compile.el --- S-expression SQL compiler -*- lexical-binding:t -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;; Author: Christopher Wellons <wellonsNOSPAMnullprogram.com>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: Unlicense
-
-;;; 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 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)."
- (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-compile.el ends here
+++ /dev/null
-;;; 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 <wellonsNOSPAMnullprogram.com>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
+++ /dev/null
-;;; 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 <wellonsNOSPAMnullprogram.com>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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 "pg"
- ( dbname user &optional
- (password "") (host "localhost") (port 5432) (tls nil)))
-(declare-function pg-disconnect "pg" (con))
-(declare-function pg-exec "pg" (connection &rest args))
-(declare-function pg-result "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
+++ /dev/null
-;; -*- no-byte-compile: t; lexical-binding: nil -*-
-(define-package "emacsql" "20241201.1551"
- "High-level SQL database front-end."
- '((emacs "26.1"))
- :url "https://github.com/magit/emacsql"
- :commit "d6529f010a0573630122b826230e72157ab8fa88"
- :revdesc "d6529f010a05"
- :authors '(("Christopher Wellons" . "wellons@nullprogram.com"))
- :maintainers '(("Jonas Bernoulli" . "emacs.emacsqlNOSPAMjonas.bernoulli.dev")))
+++ /dev/null
-;;; 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 <wellonsNOSPAMnullprogram.com>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
+++ /dev/null
-;;; 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.emacsqlNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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)
-
-(require 'sqlite nil t)
-(declare-function sqlite-open "sqlite")
-(declare-function sqlite-select "sqlite")
-(declare-function sqlite-close "sqlite")
-
-(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 _)
- (require (quote sqlite))
- (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))
- (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
+++ /dev/null
-;;; emacsql-sqlite-common.el --- Transitional library that should not be loaded -*- lexical-binding:t -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;; Author: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: Unlicense
-
-;;; Commentary:
-
-;; Transitional library that should not be loaded. If your package still
-;; requires this library, change it to require `emacsql-sqlite' instead.
-
-;;; Code:
-
-(require 'emacsql-sqlite)
-
-(provide 'emacsql-sqlite-common)
-
-;;; emacsql-sqlite-common.el ends here
-
+++ /dev/null
-;;; 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.emacsqlNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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)
-(declare-function sqlite3-open "ext:sqlite3-api")
-(declare-function sqlite3-exec "ext:sqlite3-api")
-(declare-function sqlite3-close "ext: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))
- (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
+++ /dev/null
-;;; emacsql-sqlite.el --- Code used by multiple SQLite back-ends -*- lexical-binding:t -*-
-
-;; This is free and unencumbered software released into the public domain.
-
-;; Author: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-
-;; SPDX-License-Identifier: Unlicense
-
-;;; Commentary:
-
-;; This library contains code that is used by multiple 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 the names of all tables in CONNECTION.
-Tables whose names begin with \"sqlite_\", are not included
-in the returned value."
- (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
+++ /dev/null
-;;; 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 <wellonsNOSPAMnullprogram.com>
-;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
-;; Homepage: https://github.com/magit/emacsql
-
-;; Package-Version: 20241201.1551
-;; Package-Revision: d6529f010a05
-;; 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.
-
-;; 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.1.0")
-
-(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', `psql' and
-`sqlite' back-ends. It is not being used by the `sqlite-builtin' and
-`sqlite-module' back-ends, which only use `emacsql-sqlite-busy-timeout'.")
-
-(defvar emacsql-data-root
- (file-name-directory (or load-file-name buffer-file-name))
- "Directory where EmacSQL is installed.")
-
-;;; 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)))))
-
-(cl-defgeneric emacsql-process (this)
- "Access internal `handle' slot directly, which you shouldn't do.
-Using this function to do it anyway, means additionally using a
-misnamed and obsolete accessor function."
- (and (slot-boundp this 'handle)
- (oref this handle)))
-(cl-defmethod (setf emacsql-process) (value (this emacsql-connection))
- (oset this handle value))
-(make-obsolete 'emacsql-process "underlying slot is for internal use only."
- "EmacSQL 4.0.0")
-
-(cl-defmethod slot-missing ((connection emacsql-connection)
- slot-name operation &optional new-value)
- "Treat removed `process' slot-name as an alias for internal `handle' slot."
- (pcase (list operation slot-name)
- ('(oref process)
- (message "EmacSQL: Slot `process' is obsolete")
- (oref connection handle))
- ('(oset process)
- (message "EmacSQL: Slot `process' is obsolete")
- (oset connection handle new-value))
- (_ (cl-call-next-method))))
-
-;;; 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* ((mask (and 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 () ()
- "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 (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."
- (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))
-
-;;; emacsql.el ends here
--- /dev/null
+# 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 -->
--- /dev/null
+;;; 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)))
+
+
+\f
+;;; 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-"))
+
+\f
+;;; Generated autoloads from emacsql-compiler.el
+
+(register-definition-prefixes "emacsql-compiler" '("emacsql-"))
+
+\f
+;;; Generated autoloads from emacsql-mysql.el
+
+(register-definition-prefixes "emacsql-mysql" '("emacsql-mysql-"))
+
+\f
+;;; Generated autoloads from emacsql-pg.el
+
+(register-definition-prefixes "emacsql-pg" '("emacsql-pg-connection"))
+
+\f
+;;; Generated autoloads from emacsql-psql.el
+
+(register-definition-prefixes "emacsql-psql" '("emacsql-psql-"))
+
+\f
+;;; Generated autoloads from emacsql-sqlite.el
+
+(register-definition-prefixes "emacsql-sqlite" '("emacsql-"))
+
+\f
+;;; Generated autoloads from emacsql-sqlite-builtin.el
+
+(register-definition-prefixes "emacsql-sqlite-builtin" '("emacsql-sqlite-builtin-connection"))
+
+\f
+;;; Generated autoloads from emacsql-sqlite-module.el
+
+(register-definition-prefixes "emacsql-sqlite-module" '("emacsql-sqlite-module-connection"))
+\f
+;;; 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
--- /dev/null
+;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-
+
+;; This is free and unencumbered software released into the public domain.
+
+;; Author: Christopher Wellons <wellonsNOSPAMnullprogram.com>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
--- /dev/null
+;;; 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 <wellonsNOSPAMnullprogram.com>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
--- /dev/null
+;;; 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 <wellonsNOSPAMnullprogram.com>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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 "pg"
+ ( dbname user &optional
+ (password "") (host "localhost") (port 5432) (tls nil)))
+(declare-function pg-disconnect "pg" (con))
+(declare-function pg-exec "pg" (connection &rest args))
+(declare-function pg-result "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
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "emacsql" "20250401.1500"
+ "High-level SQL database front-end."
+ '((emacs "26.1"))
+ :url "https://github.com/magit/emacsql"
+ :commit "5470adaf5dcabebc80c913ac831258fd47a87cbe"
+ :revdesc "5470adaf5dca"
+ :authors '(("Christopher Wellons" . "wellonsNOSPAMnullprogram.com"))
+ :maintainers '(("Jonas Bernoulli" . "emacs.emacsqlNOSPAMjonas.bernoulli.dev")))
--- /dev/null
+;;; 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 <wellonsNOSPAMnullprogram.com>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
--- /dev/null
+;;; 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.emacsqlNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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))
+ (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
--- /dev/null
+;;; 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.emacsqlNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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)
+(declare-function sqlite3-open "ext:sqlite3-api")
+(declare-function sqlite3-exec "ext:sqlite3-api")
+(declare-function sqlite3-close "ext: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))
+ (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
--- /dev/null
+;;; 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.emacsqlNOSPAMjonas.bernoulli.dev>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.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
--- /dev/null
+;;; 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 <wellonsNOSPAMnullprogram.com>
+;; Maintainer: Jonas Bernoulli <emacs.emacsqlNOSPAMjonas.bernoulli.dev>
+;; Homepage: https://github.com/magit/emacsql
+
+;; Package-Version: 20250401.1500
+;; Package-Revision: 5470adaf5dca
+;; 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.
+
+;; 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.0")
+
+(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
projects / emacsconfig.git / commitdiff