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

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-02-26 20:16:44 +01:00
parent 59db017445
commit 45d49daef0
291 changed files with 16240 additions and 522600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
lisp/emacsql/emacsql-compiler.el
View File

@@ -1,17 +1,22 @@
;;; emacsql-compile.el --- S-expression SQL compiler -*- lexical-binding:t -*-
;;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides support for compiling S-expressions to SQL.
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
;;; Error symbols
(defmacro emacsql-deferror (symbol parents message)
@@ -20,8 +25,8 @@
(let ((conditions (cl-remove-duplicates
(append parents (list symbol 'emacsql-error 'error)))))
`(prog1 ',symbol
(setf (get ',symbol 'error-conditions) ',conditions
(get ',symbol 'error-message) ,message))))
(put ',symbol 'error-conditions ',conditions)
(put ',symbol 'error-message ,message))))
(emacsql-deferror emacsql-error () ;; parent condition for all others
"EmacSQL had an unhandled condition")
@@ -121,7 +126,7 @@
(defun emacsql-escape-vector (vector)
"Encode VECTOR into a SQL vector scalar."
(cl-typecase vector
(null (emacsql-error "Empty SQL vector expression."))
(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))))
@@ -145,7 +150,7 @@
(upcase (replace-regexp-in-string "-" " " name))))
(defun emacsql--prepare-constraints (constraints)
"Compile CONSTRAINTS into a partial SQL expresson."
"Compile CONSTRAINTS into a partial SQL expression."
(mapconcat
#'identity
(cl-loop for constraint in constraints collect
@@ -210,21 +215,21 @@
A parameter is a symbol that looks like $i1, $s2, $v3, etc. The
letter refers to the type: identifier (i), scalar (s),
vector (v), raw string (r), schema (S)."
(when (symbolp thing)
(let ((name (symbol-name thing)))
(when (string-match-p "^\\$[isvrS][0-9]+$" name)
(cons (1- (read (substring name 2)))
(cl-ecase (aref name 1)
(?i :identifier)
(?s :scalar)
(?v :vector)
(?r :raw)
(?S :schema)))))))
(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
`svector', `expr', `subsql', and `combine'. BODY should return a
string, which will be combined with variable definitions."
(declare (indent 1))
`(let ((emacsql--vars ()))
@@ -236,7 +241,7 @@ string, which will be combined with variable definitions."
(svector (thing) (combine (emacsql--*vector thing)))
(expr (thing) (combine (emacsql--*expr thing)))
(subsql (thing)
(format "(%s)" (combine (emacsql-prepare thing)))))
(format "(%s)" (combine (emacsql-prepare thing)))))
(cons (concat ,prefix (progn ,@body)) emacsql--vars))))
(defun emacsql--!param (thing &optional kind)
@@ -244,9 +249,9 @@ string, which will be combined with variable definitions."
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))))
(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
@@ -264,7 +269,7 @@ Only use within `emacsql-with-params'!"
(emacsql-escape-scalar thing))))
(prog1 (if (eq (cdr param) :schema) "(%s)" "%s")
(check param)
(setf emacsql--vars (nconc emacsql--vars (list param))))))))
(setq emacsql--vars (nconc emacsql--vars (list param))))))))
(defun emacsql--*vector (vector)
"Prepare VECTOR."
@@ -275,23 +280,22 @@ Only use within `emacsql-with-params'!"
(vector (format "(%s)" (mapconcat #'scalar vector ", ")))
(otherwise (emacsql-error "Invalid vector: %S" vector)))))
(defmacro emacsql--generate-op-lookup-defun (name
operator-precedence-groups)
(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
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
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)))
\(((+ :unary (\"+\" :operand)) (- :unary (\"-\" :operand)))
((+ :binary) (- :binary)))"
`(defun ,name (operator-name operator-argument-count)
"Look up predefined SQL operator metadata.
@@ -349,34 +353,34 @@ See `emacsql--generate-op-lookup-defun' for details."
"Create format-string for an SQL operator.
The format-string returned is intended to be used with `format'
to create an SQL expression."
(when expr
(cl-labels ((replace-operand (x) (if (eq x :operand)
"%s"
x))
(to-format-string (e) (mapconcat #'replace-operand e "")))
(cond
((and (eq arity :unary) (eql argument-count 1))
(to-format-string expr))
((and (eq arity :binary) (>= argument-count 2))
(let ((result (reverse expr)))
(dotimes (_ (- argument-count 2))
(setf result (nconc (reverse expr) (cdr result))))
(to-format-string (nreverse result))))
(t (emacsql-error "Wrong number of operands for %s" op))))))
(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
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)))
(let ((expanded-format-string
(emacsql--expand-format-string
op
format-string
arity
argument-count)))
(cl-values (cond
((null format-string) nil)
((>= parent-precedence-value
@@ -397,10 +401,11 @@ string returned is wrapped with parentheses."
(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))))
(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)))
(emacsql-error "Wrong number of operands for %s" op)))
(cl-case op
;; Special cases <= >=
((<= >=)
@@ -466,7 +471,7 @@ string returned is wrapped with parentheses."
"Append parameters from PREPARED to `emacsql--vars', return the string.
Only use within `emacsql-with-params'!"
(cl-destructuring-bind (string . vars) prepared
(setf emacsql--vars (nconc emacsql--vars vars))
(setq emacsql--vars (nconc emacsql--vars vars))
string))
(defun emacsql-prepare--string (string)
@@ -506,9 +511,8 @@ Only use within `emacsql-with-params'!"
(emacsql-escape-format
(emacsql-escape-scalar item))))
into parts
do (setf last item)
finally (cl-return
(mapconcat #'identity parts " ")))))
do (setq last item)
finally (cl-return (string-join parts " ")))))
(defun emacsql-prepare (sql)
"Expand SQL (string or sexp) into a prepared statement."
@@ -539,4 +543,4 @@ Only use within `emacsql-with-params'!"
(provide 'emacsql-compiler)
;;; emacsql-compile.el ends here
;;; emacsql-compiler.el ends here

7
lisp/emacsql/emacsql-mysql.el
View File

@@ -3,11 +3,8 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1") (emacsql "20230220"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
@@ -126,7 +123,7 @@ http://dev.mysql.com/doc/refman/5.5/en/reserved-words.html")
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (setf row ())
and do (setq row ())
and do (forward-char)
finally (cl-return rows)))))

12
lisp/emacsql/emacsql-pg.el
View File

@@ -3,17 +3,15 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1") (emacsql "20230220") (pg "0.16"))
;; 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.
;; 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'.)
@@ -21,7 +19,9 @@
(require 'emacsql)
(require 'pg nil t)
(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)))

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

@@ -1,11 +1,11 @@
(define-package "emacsql" "20230417.1448" "High-level SQL database front-end"
'((emacs "25.1"))
:commit "64012261f65fcdd7ea137d1973ef051af1dced42" :authors
(define-package "emacsql" "20250223.1743" "High-level SQL database front-end"
'((emacs "26.1"))
:commit "e4f1dcae91f91c5fa6dc1b0097a6c524e98fdf2b" :authors
'(("Christopher Wellons" . "wellons@nullprogram.com"))
:maintainers
'(("Jonas Bernoulli" . "jonas@bernoul.li"))
'(("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev"))
:maintainer
'("Jonas Bernoulli" . "jonas@bernoul.li")
'("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")
:url "https://github.com/magit/emacsql")
;; Local Variables:
;; no-byte-compile: t

16
lisp/emacsql/emacsql-psql.el
View File

@@ -3,10 +3,8 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1") (emacsql "20230220"))
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
@@ -77,7 +75,7 @@ http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
(when hostname
(push "-h" args)
(push hostname args))
(setf args (nreverse args))
(setq args (nreverse args))
(let* ((buffer (generate-new-buffer " *emacsql-psql*"))
(psql emacsql-psql-executable)
(command (mapconcat #'shell-quote-argument (cons psql args) " "))
@@ -117,9 +115,9 @@ http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
(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)))))))
((> (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)
@@ -139,7 +137,7 @@ http://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html")
collect (read) into row
when (looking-at "\n")
collect row into rows
and do (progn (forward-char 1) (setf row ()))
and do (progn (forward-char 1) (setq row ()))
finally (cl-return rows)))))
(provide 'emacsql-psql)

37
lisp/emacsql/emacsql-sqlite-builtin.el
View File

@@ -2,11 +2,9 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "29") (emacsql "20230220"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
@@ -16,8 +14,7 @@
;;; Code:
(require 'emacsql)
(require 'emacsql-sqlite-common)
(require 'emacsql-sqlite)
(require 'sqlite nil t)
(declare-function sqlite-open "sqlite")
@@ -33,10 +30,8 @@
((connection emacsql-sqlite-builtin-connection) &rest _)
(require (quote sqlite))
(oset connection handle
(sqlite-open (slot-value connection 'file)))
(when emacsql-global-timeout
(emacsql connection [:pragma (= busy-timeout $s1)]
(/ (* emacsql-global-timeout 1000) 2)))
(sqlite-open (oref connection file)))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
@@ -45,7 +40,7 @@
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."
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-builtin-connection
:file file)))
(when debug
@@ -62,14 +57,18 @@ buffer. This is for debugging purposes."
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-builtin-connection) message)
(condition-case err
(mapcar (lambda (row)
(mapcar (lambda (col)
(cond ((null col) nil)
((equal col "") "")
((numberp col) col)
(t (read col))))
row))
(sqlite-select (oref connection handle) message nil nil))
(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)))

237
lisp/emacsql/emacsql-sqlite-common.el
View File

@@ -1,245 +1,22 @@
;;; emacsql-sqlite-common.el --- Code used by multiple SQLite back-ends -*- lexical-binding:t -*-
;;; 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 <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library contains code that is used by multiple SQLite back-ends.
;; Transitional library that should not be loaded. If your package still
;; requires this library, change it to require `emacsql-sqlite' instead.
;;; 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.")
;;; Utilities
(defun emacsql-sqlite-open (file &optional debug)
"Open a connected 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."
(let* ((class (emacsql-sqlite-default-connection))
(connection (make-instance class :file file)))
(when (eq class 'emacsql-sqlite-connection)
(set-process-query-on-exit-flag (oref connection handle) nil))
(when debug
(emacsql-enable-debugging connection))
connection))
(defun emacsql-sqlite-default-connection ()
"Determine and return the best SQLite connection class.
If a module or binary is required and that doesn't exist yet,
then try to compile it. Signal an error if no connection class
can be used."
(or (and (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. `sqlite3' elisp library isn't available.
;; 2. `libsqlite' shared library isn't available.
;; 3. `libsqlite' compilation fails.
;; 4. User chooses to not compile `libsqlite'.
(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, the best
EmacSQL backend is provided by 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'.
In the current Emacs instance the legacy backend is used, which
uses a custom SQLite executable. Using an external process like
that is less reliable and less performant, and in a few releases
support for that might be removed.
[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)))
(and (require 'emacsql-sqlite)
(boundp 'emacsql-sqlite-executable)
(or (file-exists-p emacsql-sqlite-executable)
(with-demoted-errors
"Cannot use `emacsql-sqlite-connection': %S"
(and (fboundp 'emacsql-sqlite-compile)
(emacsql-sqlite-compile 2))))
'emacsql-sqlite-connection)
(error "EmacSQL could not find or compile a back-end")))
(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)))))
(require 'emacsql-sqlite)
(provide 'emacsql-sqlite-common)
;;; emacsql-sqlite-common.el ends here

40
lisp/emacsql/emacsql-sqlite-module.el
View File

@@ -2,11 +2,9 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25") (emacsql "20230220") (sqlite3 "0.16"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
@@ -16,13 +14,12 @@
;;; Code:
(require 'emacsql)
(require 'emacsql-sqlite-common)
(require 'emacsql-sqlite)
(require 'sqlite3 nil t)
(declare-function sqlite3-open "sqlite3-api")
(declare-function sqlite3-exec "sqlite3-api")
(declare-function sqlite3-close "sqlite3-api")
(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)
@@ -35,12 +32,10 @@
((connection emacsql-sqlite-module-connection) &rest _)
(require (quote sqlite3))
(oset connection handle
(sqlite3-open (or (slot-value connection 'file) ":memory:")
(sqlite3-open (or (oref connection file) ":memory:")
sqlite-open-readwrite
sqlite-open-create))
(when emacsql-global-timeout
(emacsql connection [:pragma (= busy-timeout $s1)]
(/ (* emacsql-global-timeout 1000) 2)))
(emacsql-sqlite-set-busy-timeout connection)
(emacsql connection [:pragma (= foreign-keys on)])
(emacsql-register connection))
@@ -49,7 +44,7 @@
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."
buffer. This is for debugging purposes."
(let ((connection (make-instance #'emacsql-sqlite-module-connection
:file file)))
(when debug
@@ -66,14 +61,19 @@ buffer. This is for debugging purposes."
(cl-defmethod emacsql-send-message
((connection emacsql-sqlite-module-connection) message)
(condition-case err
(let (rows)
(let ((include-header emacsql-include-header)
(rows ()))
(sqlite3-exec (oref connection handle)
message
(lambda (_ row __)
(push (mapcar (lambda (col)
(cond ((null col) nil)
((equal col "") "")
(t (read col))))
(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))

401
lisp/emacsql/emacsql-sqlite.el
View File

@@ -1,182 +1,295 @@
;;; emacsql-sqlite.el --- EmacSQL back-end for SQLite -*- lexical-binding:t -*-
;;; 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: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Homepage: https://github.com/magit/emacsql
;; Author: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1") (emacsql "20230220"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; This library provides the original EmacSQL back-end for SQLite,
;; which uses a custom binary for communicating with a SQLite database.
;; During package installation an attempt is made to compile the binary.
;; This library contains code that is used by multiple SQLite back-ends.
;;; Code:
(require 'emacsql)
(require 'emacsql-sqlite-common)
(emacsql-register-reserved emacsql-sqlite-reserved)
;;; Base class
;;; SQLite connection
(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)
(defvar emacsql-sqlite-data-root
(file-name-directory (or load-file-name buffer-file-name))
"Directory where EmacSQL is installed.")
;;; Constants
(defvar emacsql-sqlite-executable-path
(if (memq system-type '(windows-nt cygwin ms-dos))
"sqlite/emacsql-sqlite.exe"
"sqlite/emacsql-sqlite")
"Relative path to emacsql executable.")
(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.")
(defvar emacsql-sqlite-executable
(expand-file-name emacsql-sqlite-executable-path
(if (or (file-writable-p emacsql-sqlite-data-root)
(file-exists-p (expand-file-name
emacsql-sqlite-executable-path
emacsql-sqlite-data-root)))
emacsql-sqlite-data-root
(expand-file-name
(concat "emacsql/" emacsql-version)
user-emacs-directory)))
"Path to the EmacSQL backend (this is not the sqlite3 shell).")
(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.")
(defvar emacsql-sqlite-c-compilers '("cc" "gcc" "clang")
"List of names to try when searching for a C compiler.
;;; Variables
Each is queried using `executable-find', so full paths are
allowed. Only the first compiler which is successfully found will
used.")
(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'.")
(defclass emacsql-sqlite-connection
(emacsql--sqlite-base emacsql-protocol-mixin) ()
"A connection to a SQLite database.")
(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.")
(cl-defmethod initialize-instance :after
((connection emacsql-sqlite-connection) &rest _rest)
(emacsql-sqlite-ensure-binary)
(let* ((process-connection-type nil) ; use a pipe
;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=60872#11.
(coding-system-for-write 'utf-8)
(coding-system-for-read 'utf-8)
(file (slot-value connection 'file))
(buffer (generate-new-buffer " *emacsql-sqlite*"))
(fullfile (if file (expand-file-name file) ":memory:"))
(process (start-process
"emacsql-sqlite" buffer emacsql-sqlite-executable fullfile)))
(oset connection handle process)
(set-process-sentinel process
(lambda (proc _) (kill-buffer (process-buffer proc))))
(when (memq (process-status process) '(exit signal))
(error "%s has failed immediately" emacsql-sqlite-executable))
(emacsql-wait connection)
(emacsql connection [:pragma (= busy-timeout $s1)]
(/ (* emacsql-global-timeout 1000) 2))
(emacsql-register connection)))
;;; Utilities
(cl-defun emacsql-sqlite (file &key debug)
"Open a connected to database stored in FILE.
If FILE is nil use an in-memory database.
(defun emacsql-sqlite-connection (variable file &optional setup use-module)
"Return the connection stored in VARIABLE to the database in FILE.
:debug LOG -- When non-nil, log all SQLite commands to a log
buffer. This is for debugging purposes."
(let ((connection (make-instance 'emacsql-sqlite-connection :file file)))
(set-process-query-on-exit-flag (oref connection handle) nil)
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))
(cl-defmethod emacsql-close ((connection emacsql-sqlite-connection))
"Gracefully exits the SQLite subprocess."
(let ((process (oref connection handle)))
(when (process-live-p process)
(process-send-eof process))))
(defun emacsql-sqlite-default-connection (&optional use-module)
"Determine and return the best SQLite connection class.
(cl-defmethod emacsql-send-message ((connection emacsql-sqlite-connection) message)
(let ((process (oref connection handle)))
(process-send-string process (format "%d " (string-bytes message)))
(process-send-string process message)
(process-send-string process "\n")))
Signal an error if none of the connection classes can be used.
(cl-defmethod emacsql-handle ((_ emacsql-sqlite-connection) errcode errmsg)
"Get condition for ERRCODE and ERRMSG provided from SQLite."
(pcase-let ((`(,_ ,_ ,signal ,errstr)
(assq errcode emacsql-sqlite-error-codes)))
(signal (or signal 'emacsql-error)
(list errmsg errcode nil errstr))))
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].
;;; SQLite compilation
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'.
(defun emacsql-sqlite-compile-switches ()
"Return the compilation switches from the Makefile under sqlite/."
(let ((makefile (expand-file-name "sqlite/Makefile" emacsql-sqlite-data-root))
(case-fold-search nil))
(with-temp-buffer
(insert-file-contents makefile)
(goto-char (point-min))
(cl-loop while (re-search-forward "-D[A-Z0-9_=]+" nil :no-error)
collect (match-string 0)))))
The legacy backend, which uses a custom SQLite executable, has
been remove, so we can no longer fall back to that.
(defun emacsql-sqlite-compile (&optional o-level async error)
"Compile the SQLite back-end for EmacSQL, returning non-nil on success.
If called with non-nil ASYNC, the return value is meaningless.
If called with non-nil ERROR, signal an error on failure."
(let* ((cc (cl-loop for option in emacsql-sqlite-c-compilers
for path = (executable-find option)
if path return it))
(src (expand-file-name "sqlite" emacsql-sqlite-data-root))
(files (mapcar (lambda (f) (expand-file-name f src))
'("sqlite3.c" "emacsql.c")))
(cflags (list (format "-I%s" src) (format "-O%d" (or o-level 2))))
(ldlibs (cl-case system-type
(windows-nt (list))
(berkeley-unix (list "-lm"))
(otherwise (list "-lm" "-ldl"))))
(options (emacsql-sqlite-compile-switches))
(output (list "-o" emacsql-sqlite-executable))
(arguments (nconc cflags options files ldlibs output)))
[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
((not cc)
(funcall (if error #'error #'message)
"Could not find C compiler, skipping SQLite build")
nil)
(t
(message "Compiling EmacSQL SQLite binary...")
(mkdir (file-name-directory emacsql-sqlite-executable) t)
(let ((log (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer log
(let ((inhibit-read-only t))
(insert (mapconcat #'identity (cons cc arguments) " ") "\n")
(let ((pos (point))
(ret (apply #'call-process cc nil (if async 0 t) t
arguments)))
(cond
((zerop ret)
(message "Compiling EmacSQL SQLite binary...done")
t)
((and error (not async))
(error "Cannot compile EmacSQL SQLite binary: %S"
(replace-regexp-in-string
"\n" " "
(buffer-substring-no-properties
pos (point-max))))))))))))))
((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")))))
;;; Ensure the SQLite binary is available
(defun emacsql-sqlite-restore-database (db dump)
"Restore database DB from DUMP.
(defun emacsql-sqlite-ensure-binary ()
"Ensure the EmacSQL SQLite binary is available, signaling an error if not."
(unless (file-exists-p emacsql-sqlite-executable)
;; Try compiling at the last minute.
(condition-case err
(emacsql-sqlite-compile 2 nil t)
(error (error "No EmacSQL SQLite binary available: %s" (cdr err))))))
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)

128
lisp/emacsql/emacsql.el
View File

@@ -3,61 +3,20 @@
;; This is free and unencumbered software released into the public domain.
;; Author: Christopher Wellons <wellons@nullprogram.com>
;; Maintainer: Jonas Bernoulli <jonas@bernoul.li>
;; Maintainer: Jonas Bernoulli <emacs.emacsql@jonas.bernoulli.dev>
;; Homepage: https://github.com/magit/emacsql
;; Package-Version: 3.1.1.50-git
;; Package-Requires: ((emacs "25.1"))
;; Package-Version: 4.1.0
;; Package-Requires: ((emacs "26.1"))
;; SPDX-License-Identifier: Unlicense
;;; Commentary:
;; EmacSQL is a high-level Emacs Lisp front-end for SQLite
;; (primarily), PostgreSQL, MySQL, and potentially other SQL
;; databases. On MELPA, each of the backends is provided through
;; separate packages: emacsql-sqlite, emacsql-psql, emacsql-mysql.
;; EmacSQL is a high-level Emacs Lisp front-end for SQLite.
;; Most EmacSQL functions operate on a database connection. For
;; example, a connection to SQLite is established with
;; `emacsql-sqlite'. For each such connection a sqlite3 inferior
;; process is kept alive in the background. Connections are closed
;; with `emacsql-close'.
;; (defvar db (emacsql-sqlite "company.db"))
;; Use `emacsql' to send an s-expression SQL statements to a connected
;; database. Identifiers for tables and columns are symbols. SQL
;; keywords are lisp keywords. Anything else is data.
;; (emacsql db [:create-table people ([name id salary])])
;; Column constraints can optionally be provided in the schema.
;; (emacsql db [:create-table people ([name (id integer :unique) salary])])
;; Insert some values.
;; (emacsql db [:insert :into people
;; :values (["Jeff" 1000 60000.0] ["Susan" 1001 64000.0])])
;; Currently all actions are synchronous and Emacs will block until
;; SQLite has indicated it is finished processing the last command.
;; Query the database for results:
;; (emacsql db [:select [name id] :from employees :where (> salary 60000)])
;; ;; => (("Susan" 1001))
;; Queries can be templates -- $i1, $s2, etc. -- so they don't need to
;; be built up dynamically:
;; (emacsql db
;; [:select [name id] :from employees :where (> salary $s1)]
;; 50000)
;; ;; => (("Jeff" 1000) ("Susan" 1001))
;; The letter declares the type (identifier, scalar, vector, Schema)
;; and the number declares the argument position.
;; PostgreSQL and MySQL are also supported, but use of these connectors
;; is not recommended.
;; See README.md for much more complete documentation.
@@ -73,11 +32,13 @@
"The EmacSQL SQL database front-end."
:group 'comm)
(defconst emacsql-version "3.1.1.50-git")
(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.")
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))
@@ -94,7 +55,6 @@ may return `process', `user-ptr' or `sqlite' for this value.")
(log-buffer :type (or null buffer)
:initarg :log-buffer
:initform nil
:accessor emacsql-log-buffer
:documentation "Output log (debug).")
(finalizer :documentation "Object returned from `make-finalizer'.")
(types :allocation :class
@@ -112,14 +72,14 @@ may return `process', `user-ptr' or `sqlite' for this value.")
(cl-defmethod emacsql-live-p ((connection emacsql-connection))
"Return non-nil if CONNECTION is still alive and ready."
(not (null (process-live-p (oref connection handle)))))
(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.")
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."
@@ -127,14 +87,13 @@ SQL expression.")
(cl-defmethod emacsql-enable-debugging ((connection emacsql-connection))
"Enable debugging on CONNECTION."
(unless (buffer-live-p (emacsql-log-buffer connection))
(setf (emacsql-log-buffer connection)
(generate-new-buffer " *emacsql-log*"))))
(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 (emacsql-log-buffer connection)))
(let ((buffer (oref connection log-buffer)))
(when buffer
(unless (buffer-live-p buffer)
(setq buffer (emacsql-enable-debugging connection)))
@@ -147,11 +106,11 @@ MESSAGE should not have a newline on the end."
Using this function to do it anyway, means additionally using a
misnamed and obsolete accessor function."
(and (slot-boundp this 'handle)
(eieio-oref this 'handle)))
(oref this handle)))
(cl-defmethod (setf emacsql-process) (value (this emacsql-connection))
(eieio-oset this 'handle value))
(oset this handle value))
(make-obsolete 'emacsql-process "underlying slot is for internal use only."
"Emacsql 4.0.0")
"EmacSQL 4.0.0")
(cl-defmethod slot-missing ((connection emacsql-connection)
slot-name operation &optional new-value)
@@ -187,7 +146,7 @@ misnamed and obsolete accessor function."
(cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout)
"Block until CONNECTION is waiting for further input."
(let* ((real-timeout (or timeout emacsql-global-timeout))
(end (when real-timeout (+ (float-time) real-timeout))))
(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
@@ -200,7 +159,7 @@ misnamed and obsolete accessor function."
(defun emacsql-compile (connection sql &rest args)
"Compile s-expression SQL for CONNECTION into a string."
(let* ((mask (when connection (emacsql-types connection)))
(let* ((mask (and connection (emacsql-types connection)))
(emacsql-type-map (or mask emacsql-type-map)))
(concat (apply #'emacsql-format (emacsql-prepare sql) args) ";")))
@@ -218,9 +177,9 @@ misnamed and obsolete accessor function."
(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
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)
@@ -258,9 +217,9 @@ specific error conditions."
(defun emacsql-register (connection)
"Register CONNECTION for automatic cleanup and return CONNECTION."
(let ((finalizer (make-finalizer (lambda () (emacsql-close connection)))))
(prog1 connection
(setf (slot-value connection 'finalizer) finalizer))))
(prog1 connection
(oset connection finalizer
(make-finalizer (lambda () (emacsql-close connection))))))
;;; Useful macros
@@ -287,7 +246,7 @@ 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
changes to the database behind CONNECTION. Body may be evaluated
multiple times before the changes are committed."
(declare (indent 1))
`(let ((emacsql--connection ,connection)
@@ -301,10 +260,10 @@ multiple times before the changes are committed."
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:begin]))
(let ((result (progn ,@body)))
(setf emacsql--result result)
(setq emacsql--result result)
(when (= 1 emacsql--transaction-level)
(emacsql emacsql--connection [:commit]))
(setf emacsql--completed t)))
(setq emacsql--completed t)))
(emacsql-locked (emacsql emacsql--connection [:rollback])
(sleep-for 0.05))))
(when (and (= 1 emacsql--transaction-level)
@@ -329,8 +288,8 @@ A statement can be a list, containing a statement with its arguments."
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
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]
@@ -344,16 +303,16 @@ compile time. For example, in the expression below the variables
Each column must be a plain symbol, no expressions allowed here."
(declare (indent 2))
(let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args)))
(args (unless (vectorp sql-and-args) (cdr sql-and-args))))
(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'."))
(error "Must explicitly list columns in `emacsql-with-bind'"))
(cl-assert (cl-every #'symbolp vars))
`(let ((emacsql--results (emacsql ,connection ,sql ,@args))
(emacsql--final nil))
(dolist (emacsql--result emacsql--results emacsql--final)
(setf emacsql--final
(setq emacsql--final
(cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result
,@body)))))))
@@ -380,14 +339,7 @@ Each column must be a plain symbol, no expressions allowed here."
(sql-mode)
(with-no-warnings ;; autoloaded by previous line
(sql-highlight-sqlite-keywords))
(if (and (fboundp 'font-lock-flush)
(fboundp 'font-lock-ensure))
(save-restriction
(widen)
(font-lock-flush)
(font-lock-ensure))
(with-no-warnings
(font-lock-fontify-buffer)))
(font-lock-ensure)
(emacsql--indent)
(buffer-string))))
(with-current-buffer (get-buffer-create emacsql-show-buffer-name)
@@ -432,9 +384,9 @@ A prefix argument causes the SQL to be printed into the current buffer."
(save-excursion
(beginning-of-defun)
(let ((containing-sexp (elt (parse-partial-sexp (point) start) 1)))
(when containing-sexp
(goto-char containing-sexp)
(looking-at "\\["))))))
(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."

19
lisp/emacsql/sqlite/Makefile
View File

@@ -1,19 +0,0 @@
-include ../.config.mk
.POSIX:
LDLIBS = -ldl -lm
CFLAGS = -O2 -Wall -Wextra -Wno-implicit-fallthrough \
-DSQLITE_THREADSAFE=0 \
-DSQLITE_DEFAULT_FOREIGN_KEYS=1 \
-DSQLITE_ENABLE_FTS5 \
-DSQLITE_ENABLE_FTS4 \
-DSQLITE_ENABLE_FTS3_PARENTHESIS \
-DSQLITE_ENABLE_RTREE \
-DSQLITE_ENABLE_JSON1 \
-DSQLITE_SOUNDEX
emacsql-sqlite: emacsql.c sqlite3.c
$(CC) $(CFLAGS) $(LDFLAGS) -o $@ emacsql.c sqlite3.c $(LDLIBS)
clean:
rm -f emacsql-sqlite

183
lisp/emacsql/sqlite/emacsql.c
View File

@@ -1,183 +0,0 @@
/* This is free and unencumbered software released into the public domain. */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "sqlite3.h"
#define TRUE 1
#define FALSE 0
char* escape(const char *message) {
int i, count = 0, length_orig = strlen(message);
for (i = 0; i < length_orig; i++) {
if (strchr("\"\\", message[i])) {
count++;
}
}
char *copy = malloc(length_orig + count + 1);
char *p = copy;
while (*message) {
if (strchr("\"\\", *message)) {
*p = '\\';
p++;
}
*p = *message;
message++;
p++;
}
*p = '\0';
return copy;
}
void send_error(int code, const char *message) {
char *escaped = escape(message);
printf("error %d \"%s\"\n", code, escaped);
free(escaped);
}
typedef struct {
char *buffer;
size_t size;
} buffer;
buffer* buffer_create() {
buffer *buffer = malloc(sizeof(*buffer));
buffer->size = 4096;
buffer->buffer = malloc(buffer->size * sizeof(char));
return buffer;
}
int buffer_grow(buffer *buffer) {
unsigned factor = 2;
char *newbuffer = realloc(buffer->buffer, buffer->size * factor);
if (newbuffer == NULL) {
return FALSE;
}
buffer->buffer = newbuffer;
buffer->size *= factor;
return TRUE;
}
int buffer_read(buffer *buffer, size_t count) {
while (buffer->size < count + 1) {
if (buffer_grow(buffer) == FALSE) {
return FALSE;
}
}
size_t in = fread((void *) buffer->buffer, 1, count, stdin);
buffer->buffer[count] = '\0';
return in == count;
}
void buffer_free(buffer *buffer) {
free(buffer->buffer);
free(buffer);
}
int main(int argc, char **argv) {
char *file = NULL;
if (argc != 2) {
fprintf(stderr,
"error: require exactly one argument, the DB filename\n");
exit(EXIT_FAILURE);
} else {
file = argv[1];
}
/* On Windows stderr is not always unbuffered. */
#if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__)
setvbuf(stderr, NULL, _IONBF, 0);
#endif
sqlite3* db = NULL;
if (sqlite3_initialize() != SQLITE_OK) {
fprintf(stderr, "error: failed to initialize sqlite\n");
exit(EXIT_FAILURE);
}
int flags = SQLITE_OPEN_READWRITE | SQLITE_OPEN_CREATE;
if (sqlite3_open_v2(file, &db, flags, NULL) != SQLITE_OK) {
fprintf(stderr, "error: failed to open %s\n", file);
exit(EXIT_FAILURE);
}
buffer *input = buffer_create();
while (TRUE) {
printf("#\n");
fflush(stdout);
/* Gather input from Emacs. */
unsigned length;
int result = scanf("%u ", &length);
if (result == EOF) {
break;
} else if (result != 1) {
send_error(SQLITE_ERROR, "middleware parsing error");
break; /* stream out of sync: quit program */
}
if (!buffer_read(input, length)) {
send_error(SQLITE_NOMEM, "middleware out of memory");
continue;
}
/* Parse SQL statement. */
sqlite3_stmt *stmt = NULL;
result = sqlite3_prepare_v2(db, input->buffer, length, &stmt, NULL);
if (result != SQLITE_OK) {
send_error(sqlite3_errcode(db), sqlite3_errmsg(db));
continue;
}
/* Print out rows. */
int first = TRUE, ncolumns = sqlite3_column_count(stmt);
printf("(");
while (sqlite3_step(stmt) == SQLITE_ROW) {
if (first) {
printf("(");
first = FALSE;
} else {
printf("\n (");
}
int i;
for (i = 0; i < ncolumns; i++) {
if (i > 0) {
printf(" ");
}
int type = sqlite3_column_type(stmt, i);
switch (type) {
case SQLITE_INTEGER:
printf("%lld", sqlite3_column_int64(stmt, i));
break;
case SQLITE_FLOAT:
printf("%f", sqlite3_column_double(stmt, i));
break;
case SQLITE_NULL:
printf("nil");
break;
case SQLITE_TEXT:
fwrite(sqlite3_column_text(stmt, i), 1,
sqlite3_column_bytes(stmt, i), stdout);
break;
case SQLITE_BLOB:
printf("nil");
break;
}
}
printf(")");
}
printf(")\n");
if (sqlite3_finalize(stmt) != SQLITE_OK) {
/* Despite any error code, the statement is still freed.
* http://stackoverflow.com/a/8391872
*/
send_error(sqlite3_errcode(db), sqlite3_errmsg(db));
} else {
printf("success\n");
}
}
buffer_free(input);
sqlite3_close(db);
sqlite3_shutdown();
return EXIT_SUCCESS;
}

241687
lisp/emacsql/sqlite/sqlite3.c
View File

File diff suppressed because it is too large Load Diff

12836
lisp/emacsql/sqlite/sqlite3.h
View File

File diff suppressed because it is too large Load Diff