From: Andreas Gerler Date: Wed, 21 May 2025 12:03:27 +0000 (+0200) Subject: update emacsql X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=448dcf32eddb695c9d2f06ca26f2755e8b185330;p=emacsconfig.git update emacsql --- diff --git a/bba.org b/bba.org index 8cce2bfc..0a4fce93 100644 --- a/bba.org +++ b/bba.org @@ -239,7 +239,7 @@ from bash. 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") diff --git a/elpa/emacsql-20241201.1551/README.md b/elpa/emacsql-20241201.1551/README.md deleted file mode 100644 index 7185c3cf..00000000 --- a/elpa/emacsql-20241201.1551/README.md +++ /dev/null @@ -1,432 +0,0 @@ -# EmacSQL - -EmacSQL is a high-level Emacs Lisp front-end for SQLite. - -PostgreSQL and MySQL are also supported, but use of these connectors -is not recommended. - -Any [readable lisp value][readable] can be stored as a value in -EmacSQL, including numbers, strings, symbols, lists, vectors, and -closures. EmacSQL has no concept of "TEXT" values; it's all just lisp -objects. The lisp object `nil` corresponds 1:1 with `NULL` in the -database. - -Requires Emacs 26 or later. - -[![Compile](https://github.com/magit/emacsql/actions/workflows/compile.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/compile.yml) -[![Test](https://github.com/magit/emacsql/actions/workflows/test.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/test.yml) -[![NonGNU ELPA](https://emacsair.me/assets/badges/nongnu-elpa.svg)](https://elpa.nongnu.org/nongnu-devel/emacsql.html) -[![MELPA Stable](https://stable.melpa.org/packages/emacsql-badge.svg)](https://stable.melpa.org/#/emacsql) -[![MELPA](https://melpa.org/packages/emacsql-badge.svg)](https://melpa.org/#/emacsql) - -### FAQ -#### Why are all values stored as strings? - -EmacSQL is not intended to interact with arbitrary databases, but to -be an ACID-compliant database for Emacs extensions. This means that -EmacSQL cannot be used with a regular SQL database used by other -non-Emacs clients. - -All database values must be s-expressions. When EmacSQL stores a -value — string, symbol, cons, etc. — it is printed and written to -the database in its printed form. Strings are wrapped in quotes -and escaped as necessary. That means "bare" symbols in the database -generally look like strings. The only exception is `nil`, which is -stored as `NULL`. - -#### Will EmacSQL ever support arbitrary databases? - -The author of EmacSQL [thinks][mistake] that it was probably a -design mistake to restrict it to Emacs by storing only printed values, -and that it would be a lot more useful if it just handled primitive -database types. - -However, EmacSQL is in maintenance mode and there are no plans to -make any fundamental changes, not least because they would break all -existing packages and databases that rely on the current EmacSQL -behavior. - -### Windows Issues - -Emacs `start-process-shell-command` function is not supported on -Windows. Since both `emacsql-mysql` and `emacsql-psql` rely on this -function, neither of these connection types are supported on Windows. - -## Example Usage - -```el -(defvar db (emacsql-sqlite-open "~/company.db")) - -;; Create a table. Table and column identifiers are symbols. -(emacsql db [:create-table people ([name id salary])]) - -;; Or optionally provide column constraints. -(emacsql db [:create-table people - ([name (id integer :primary-key) (salary float)])]) - -;; Insert some data: -(emacsql db [:insert :into people - :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])]) - -;; Query the database for results: -(emacsql db [:select [name id] - :from people - :where (> salary 62000)]) -;; => (("Susan" 1001)) - -;; Queries can be templates, using $1, $2, etc.: -(emacsql db [:select [name id] - :from people - :where (> salary $s1)] - 50000) -;; => (("Jeff" 1000) ("Susan" 1001)) -``` - -When editing these prepared SQL s-expression statements, the `M-x -emacsql-show-last-sql` command (think `eval-last-sexp`) is useful for -seeing what the actual SQL expression will become when compiled. - -## Schema - -A table schema is a list whose first element is a vector of column -specifications. The rest of the list specifies table constraints. A -column identifier is a symbol and a column's specification can either -be just this symbol or it can include constraints as a list. Because -EmacSQL stores entire lisp objects as values, the only relevant (and -allowed) types are `integer`, `float`, and `object` (default). - - ([() ...] ( ...) ...]) - -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 - - - diff --git a/elpa/emacsql-20241201.1551/emacsql-autoloads.el b/elpa/emacsql-20241201.1551/emacsql-autoloads.el deleted file mode 100644 index bae8de93..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-autoloads.el +++ /dev/null @@ -1,68 +0,0 @@ -;;; emacsql-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from emacsql.el - -(autoload 'emacsql-show-last-sql "emacsql" "\ -Display the compiled SQL of the s-expression SQL expression before point. -A prefix argument causes the SQL to be printed into the current buffer. - -(fn &optional PREFIX)" t) -(register-definition-prefixes "emacsql" '("emacsql-")) - - -;;; Generated autoloads from emacsql-compiler.el - -(register-definition-prefixes "emacsql-compiler" '("emacsql-")) - - -;;; Generated autoloads from emacsql-mysql.el - -(register-definition-prefixes "emacsql-mysql" '("emacsql-mysql-")) - - -;;; Generated autoloads from emacsql-pg.el - -(register-definition-prefixes "emacsql-pg" '("emacsql-pg-connection")) - - -;;; Generated autoloads from emacsql-psql.el - -(register-definition-prefixes "emacsql-psql" '("emacsql-psql-")) - - -;;; Generated autoloads from emacsql-sqlite.el - -(register-definition-prefixes "emacsql-sqlite" '("emacsql-")) - - -;;; Generated autoloads from emacsql-sqlite-builtin.el - -(register-definition-prefixes "emacsql-sqlite-builtin" '("emacsql-sqlite-builtin-connection")) - - -;;; Generated autoloads from emacsql-sqlite-module.el - -(register-definition-prefixes "emacsql-sqlite-module" '("emacsql-sqlite-module-connection")) - -;;; End of scraped data - -(provide 'emacsql-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; emacsql-autoloads.el ends here diff --git a/elpa/emacsql-20241201.1551/emacsql-compiler.el b/elpa/emacsql-20241201.1551/emacsql-compiler.el deleted file mode 100644 index 12a70823..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-compiler.el +++ /dev/null @@ -1,542 +0,0 @@ -;;; emacsql-compile.el --- S-expression SQL compiler -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-mysql.el b/elpa/emacsql-20241201.1551/emacsql-mysql.el deleted file mode 100644 index f8b92071..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-mysql.el +++ /dev/null @@ -1,132 +0,0 @@ -;;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-pg.el b/elpa/emacsql-20241201.1551/emacsql-pg.el deleted file mode 100644 index d15ed597..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-pg.el +++ /dev/null @@ -1,80 +0,0 @@ -;;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-pkg.el b/elpa/emacsql-20241201.1551/emacsql-pkg.el deleted file mode 100644 index da87bbf0..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-pkg.el +++ /dev/null @@ -1,9 +0,0 @@ -;; -*- 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.emacsql@jonas.bernoulli.dev"))) diff --git a/elpa/emacsql-20241201.1551/emacsql-psql.el b/elpa/emacsql-20241201.1551/emacsql-psql.el deleted file mode 100644 index ee740351..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-psql.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-sqlite-builtin.el b/elpa/emacsql-20241201.1551/emacsql-sqlite-builtin.el deleted file mode 100644 index b98e6967..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-sqlite-builtin.el +++ /dev/null @@ -1,88 +0,0 @@ -;;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Jonas Bernoulli -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-sqlite-common.el b/elpa/emacsql-20241201.1551/emacsql-sqlite-common.el deleted file mode 100644 index 129d1401..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-sqlite-common.el +++ /dev/null @@ -1,22 +0,0 @@ -;;; 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 -;; Maintainer: Jonas Bernoulli - -;; 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 - diff --git a/elpa/emacsql-20241201.1551/emacsql-sqlite-module.el b/elpa/emacsql-20241201.1551/emacsql-sqlite-module.el deleted file mode 100644 index c3cf29ca..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-sqlite-module.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Jonas Bernoulli -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql-sqlite.el b/elpa/emacsql-20241201.1551/emacsql-sqlite.el deleted file mode 100644 index 753ee80b..00000000 --- a/elpa/emacsql-20241201.1551/emacsql-sqlite.el +++ /dev/null @@ -1,295 +0,0 @@ -;;; 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 -;; Maintainer: Jonas Bernoulli - -;; 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 diff --git a/elpa/emacsql-20241201.1551/emacsql.el b/elpa/emacsql-20241201.1551/emacsql.el deleted file mode 100644 index 0c0f00a3..00000000 --- a/elpa/emacsql-20241201.1551/emacsql.el +++ /dev/null @@ -1,406 +0,0 @@ -;;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*- - -;; This is free and unencumbered software released into the public domain. - -;; Author: Christopher Wellons -;; Maintainer: Jonas Bernoulli -;; 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 diff --git a/elpa/emacsql-20250401.1500/README.md b/elpa/emacsql-20250401.1500/README.md new file mode 100644 index 00000000..5a6e0041 --- /dev/null +++ b/elpa/emacsql-20250401.1500/README.md @@ -0,0 +1,434 @@ +# EmacSQL + +EmacSQL is a high-level Emacs Lisp front-end for SQLite. + +PostgreSQL and MySQL are also supported, but use of these connectors +is not recommended. + +Any [readable lisp value][readable] can be stored as a value in +EmacSQL, including numbers, strings, symbols, lists, vectors, and +closures. EmacSQL has no concept of "TEXT" values; it's all just lisp +objects. The lisp object `nil` corresponds 1:1 with `NULL` in the +database. + +Requires Emacs 26 or later. + +[![Compile](https://github.com/magit/emacsql/actions/workflows/compile.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/compile.yml) +[![Test](https://github.com/magit/emacsql/actions/workflows/test.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/test.yml) +[![NonGNU ELPA](https://emacsair.me/assets/badges/nongnu-elpa.svg)](https://elpa.nongnu.org/nongnu-devel/emacsql.html) +[![MELPA Stable](https://stable.melpa.org/packages/emacsql-badge.svg)](https://stable.melpa.org/#/emacsql) +[![MELPA](https://melpa.org/packages/emacsql-badge.svg)](https://melpa.org/#/emacsql) + +### FAQ +#### Why are all values stored as strings? + +EmacSQL is not intended to interact with arbitrary databases, but to +be an ACID-compliant database for Emacs extensions. This means that +EmacSQL cannot be used with a regular SQL database used by other +non-Emacs clients. + +All database values must be s-expressions. When EmacSQL stores a +value — string, symbol, cons, etc. — it is printed and written to +the database in its printed form. Strings are wrapped in quotes +and escaped as necessary. That means "bare" symbols in the database +generally look like strings. The only exception is `nil`, which is +stored as `NULL`. + +#### Will EmacSQL ever support arbitrary databases? + +The author of EmacSQL [thinks][mistake] that it was probably a +design mistake to restrict it to Emacs by storing only printed values, +and that it would be a lot more useful if it just handled primitive +database types. + +However, EmacSQL is in maintenance mode and there are no plans to +make any fundamental changes, not least because they would break all +existing packages and databases that rely on the current EmacSQL +behavior. + +### Windows Issues + +Emacs `start-process-shell-command` function is not supported on +Windows. Since both `emacsql-mysql` and `emacsql-psql` rely on this +function, neither of these connection types are supported on Windows. + +## Example Usage + +```el +(defvar db (emacsql-sqlite-open "~/company.db")) + +;; Create a table. Table and column identifiers are symbols. +(emacsql db [:create-table people ([name id salary])]) + +;; Or optionally provide column constraints. +(emacsql db [:create-table people + ([name (id integer :primary-key) (salary float)])]) + +;; Insert some data: +(emacsql db [:insert :into people + :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])]) + +;; Query the database for results: +(emacsql db [:select [name id] + :from people + :where (> salary 62000)]) +;; => (("Susan" 1001)) + +;; Queries can be templates, using $1, $2, etc.: +(emacsql db [:select [name id] + :from people + :where (> salary $s1)] + 50000) +;; => (("Jeff" 1000) ("Susan" 1001)) +``` + +When editing these prepared SQL s-expression statements, the `M-x +emacsql-show-last-sql` command (think `eval-last-sexp`) is useful for +seeing what the actual SQL expression will become when compiled. + +## Schema + +A table schema is a list whose first element is a vector of column +specifications. The rest of the list specifies table constraints. A +column identifier is a symbol and a column's specification can either +be just this symbol or it can include constraints as a list. Because +EmacSQL stores entire lisp objects as values, the only relevant (and +allowed) types are `integer`, `float`, and `object` (default). + + ([() ...] ( ...) ...]) + +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 + + + diff --git a/elpa/emacsql-20250401.1500/emacsql-autoloads.el b/elpa/emacsql-20250401.1500/emacsql-autoloads.el new file mode 100644 index 00000000..bae8de93 --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-autoloads.el @@ -0,0 +1,68 @@ +;;; emacsql-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from emacsql.el + +(autoload 'emacsql-show-last-sql "emacsql" "\ +Display the compiled SQL of the s-expression SQL expression before point. +A prefix argument causes the SQL to be printed into the current buffer. + +(fn &optional PREFIX)" t) +(register-definition-prefixes "emacsql" '("emacsql-")) + + +;;; Generated autoloads from emacsql-compiler.el + +(register-definition-prefixes "emacsql-compiler" '("emacsql-")) + + +;;; Generated autoloads from emacsql-mysql.el + +(register-definition-prefixes "emacsql-mysql" '("emacsql-mysql-")) + + +;;; Generated autoloads from emacsql-pg.el + +(register-definition-prefixes "emacsql-pg" '("emacsql-pg-connection")) + + +;;; Generated autoloads from emacsql-psql.el + +(register-definition-prefixes "emacsql-psql" '("emacsql-psql-")) + + +;;; Generated autoloads from emacsql-sqlite.el + +(register-definition-prefixes "emacsql-sqlite" '("emacsql-")) + + +;;; Generated autoloads from emacsql-sqlite-builtin.el + +(register-definition-prefixes "emacsql-sqlite-builtin" '("emacsql-sqlite-builtin-connection")) + + +;;; Generated autoloads from emacsql-sqlite-module.el + +(register-definition-prefixes "emacsql-sqlite-module" '("emacsql-sqlite-module-connection")) + +;;; End of scraped data + +(provide 'emacsql-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; emacsql-autoloads.el ends here diff --git a/elpa/emacsql-20250401.1500/emacsql-compiler.el b/elpa/emacsql-20250401.1500/emacsql-compiler.el new file mode 100644 index 00000000..575af47c --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-compiler.el @@ -0,0 +1,546 @@ +;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Christopher Wellons +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-mysql.el b/elpa/emacsql-20250401.1500/emacsql-mysql.el new file mode 100644 index 00000000..f8b92071 --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-mysql.el @@ -0,0 +1,132 @@ +;;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Christopher Wellons +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-pg.el b/elpa/emacsql-20250401.1500/emacsql-pg.el new file mode 100644 index 00000000..d15ed597 --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-pg.el @@ -0,0 +1,80 @@ +;;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Christopher Wellons +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-pkg.el b/elpa/emacsql-20250401.1500/emacsql-pkg.el new file mode 100644 index 00000000..e5a99bfe --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-pkg.el @@ -0,0 +1,9 @@ +;; -*- 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" . "wellons@nullprogram.com")) + :maintainers '(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev"))) diff --git a/elpa/emacsql-20250401.1500/emacsql-psql.el b/elpa/emacsql-20250401.1500/emacsql-psql.el new file mode 100644 index 00000000..ee740351 --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-psql.el @@ -0,0 +1,145 @@ +;;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Christopher Wellons +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-sqlite-builtin.el b/elpa/emacsql-20250401.1500/emacsql-sqlite-builtin.el new file mode 100644 index 00000000..94edd26c --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-sqlite-builtin.el @@ -0,0 +1,86 @@ +;;; 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 +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-sqlite-module.el b/elpa/emacsql-20250401.1500/emacsql-sqlite-module.el new file mode 100644 index 00000000..8dd1986e --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-sqlite-module.el @@ -0,0 +1,94 @@ +;;; 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 +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql-sqlite.el b/elpa/emacsql-20250401.1500/emacsql-sqlite.el new file mode 100644 index 00000000..3add7aeb --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql-sqlite.el @@ -0,0 +1,296 @@ +;;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*- + +;; This is free and unencumbered software released into the public domain. + +;; Author: Jonas Bernoulli +;; Maintainer: Jonas Bernoulli + +;; 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 diff --git a/elpa/emacsql-20250401.1500/emacsql.el b/elpa/emacsql-20250401.1500/emacsql.el new file mode 100644 index 00000000..baea0210 --- /dev/null +++ b/elpa/emacsql-20250401.1500/emacsql.el @@ -0,0 +1,379 @@ +;;; 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 +;; Maintainer: Jonas Bernoulli +;; 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