[ { "path": ".dir-locals.el", "content": "((nil\n (indent-tabs-mode . nil))\n (makefile-mode\n (indent-tabs-mode . t))\n (git-commit-mode\n (git-commit-major-mode . git-commit-elisp-text-mode)))\n" }, { "path": ".elpaignore", "content": ".dir-locals.el\n.elpaignore\n.github\n.gitignore\nMakefile\ntests\nUNLICENSE\n" }, { "path": ".github/workflows/compile.yml", "content": "name: Compile\non: [push, pull_request]\njobs:\n compile:\n name: Compile\n uses: | # zizmor: ignore[unpinned-uses] same maintainer as this repo\n emacscollective/workflows/.github/workflows/compile.yml@main\n" }, { "path": ".github/workflows/stats.yml", "content": "name: Statistics\non:\n push:\n branches: main\n schedule:\n - cron: '3 13 * * 1'\njobs:\n stats:\n name: Statistics\n uses: | # zizmor: ignore[unpinned-uses] same maintainer as this repo\n emacscollective/workflows/.github/workflows/stats.yml@main\n secrets:\n rclone_config: ${{ secrets.RCLONE_CONFIG }}\n" }, { "path": ".github/workflows/test.yml", "content": "name: Test\npermissions: read-all\non: [ push, pull_request ]\nenv:\n pwd: ${{ github.event.repository.name }}\njobs:\n matrix:\n name: 'Get matrix'\n runs-on: ubuntu-24.04\n outputs:\n matrix: ${{ steps.matrix.outputs.matrix }}\n steps:\n - name: 'Install Emacs'\n uses: purcell/setup-emacs@bdc64dc730ae1fcba200bfd52cb1b4cf6159cbe5 # v8\n with:\n version: 30.1\n - name: 'Install scripts'\n uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2\n with:\n repository: emacscollective/workflows\n ref: ${{ inputs.workflow_ref }}\n path: _scripts\n persist-credentials: false\n - name: 'Checkout ${{ github.repository }}'\n uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2\n with:\n path: ${{ env.pwd }}\n persist-credentials: false\n - name: 'Get matrix'\n id: matrix\n working-directory: ${{ env.pwd }}\n env:\n WORKFLOW_REF: ${{ inputs.workflow_ref }}\n run: |\n ../_scripts/bin/get-matrix >> $GITHUB_OUTPUT\n echo \"• get-matrix: emacscollective/workflows@${WORKFLOW_REF}\"\n main:\n name: 'Test using Emacs ${{ matrix.emacs }}'\n runs-on: ubuntu-24.04\n needs: matrix\n strategy:\n fail-fast: false\n matrix:\n emacs: ${{ fromJson(needs.matrix.outputs.matrix) }}\n services:\n postgres:\n image: postgres:14\n env:\n POSTGRES_PASSWORD: postgres\n POSTGRES_HOST_AUTH_METHOD: trust\n options: >-\n --health-cmd pg_isready\n --health-interval 10s\n --health-timeout 5s\n --health-retries 5\n ports:\n - 5432:5432\n mysql:\n image: mysql:8.0\n env:\n MYSQL_ROOT_PASSWORD: emacsql\n MYSQL_DATABASE: emacsql\n MYSQL_USER: emacsql\n MYSQL_PASSWORD: emacsql\n ports:\n - 3306:3306\n options: >-\n --health-cmd=\"mysqladmin ping\"\n --health-interval=10s\n --health-timeout=5s\n --health-retries=3\n steps:\n - name: 'Install Emacs'\n uses: purcell/setup-emacs@bdc64dc730ae1fcba200bfd52cb1b4cf6159cbe5 # v8\n with:\n version: ${{ matrix.emacs }}\n - name: 'Checkout scripts'\n uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2\n with:\n repository: emacscollective/workflows\n ref: ${{ inputs.workflow_ref }}\n path: _scripts\n persist-credentials: false\n - name: 'Checkout ${{ github.repository }}'\n uses: actions/checkout@de0fac2e4500dabe0009e67214ff5f5447ce83dd # v6.0.2\n with:\n path: ${{ env.pwd }}\n persist-credentials: false\n - name: 'Install dependencies'\n working-directory: ${{ env.pwd }}\n run: ../_scripts/bin/install-deps\n - name: 'Build Sqlite3'\n working-directory: sqlite3\n run: nix-shell -p sqlite.dev --run \"make all\"\n - name: 'Build Emacsql'\n run: nix-shell -p sqlite.dev --run \"make all\"\n working-directory: ${{ env.pwd }}\n - name: 'Test Emacsql'\n run: make test\n working-directory: ${{ env.pwd }}\n env:\n MYSQL_DATABASE: emacsql\n MYSQL_USER: emacsql\n MYSQL_PASSWORD: emacsql\n MYSQL_HOST: 127.0.0.1\n MYSQL_PORT: 3306\n PSQL_DATABASE: postgres\n PSQL_USER: postgres\n PSQL_HOST: 127.0.0.1\n PSQL_PORT: 5432\n PG_DATABASE: postgres\n PG_USER: postgres\n PG_PASSWORD: postgres\n PG_HOST: 127.0.0.1\n PG_PORT: 5432\n" }, { "path": ".gitignore", "content": "/*.elc\n/*-autoloads.el\n/config.mk\n/docs/stats/\n" }, { "path": "Makefile", "content": "-include config.mk\ninclude default.mk\n\n.PHONY: test\n\nall: lisp\n\nhelp:\n\t$(info make all -- Generate lisp and manual)\n\t$(info make lisp -- Generate byte-code and autoloads)\n\t$(info make redo -- Re-generate byte-code and autoloads)\n\t$(info make stats -- Generate statistics)\n\t$(info make stats-upload -- Publish statistics)\n\t$(info make test -- Run tests)\n\t$(info make test-interactive -- Run tests interactively)\n\t$(info make clean -- Remove most generated files)\n\t@printf \"\\n\"\n\nlisp: $(ELCS) autoloads check-declare\nredo: clean lisp\n\nstats:\n\t@$(MAKE) -C docs stats\nstats-upload:\n\t@$(MAKE) -C docs stats-upload\n\ntest: lisp\n\t@$(MAKE) -C test test\ntest-interactive:\n\t@$(MAKE) -C test test-interactive\n\nclean: clean-lisp clean-docs clean-test\nclean-lisp:\n\t@printf \" Cleaning *...\\n\"\n\t@rm -rf $(ELCS) $(PKG)-autoloads.el\nclean-docs:\n\t@$(MAKE) -C docs clean\nclean-test:\n\t@$(MAKE) -C test clean\n\nautoloads: $(PKG)-autoloads.el\n\n%.elc: %.el\n\t@printf \"Compiling $<\\n\"\n\t@$(EMACS_BATCH) --funcall batch-byte-compile $<\n\ncheck-declare:\n\t@printf \" Checking function declarations\\n\"\n\t@$(EMACS_BATCH) --eval \"(check-declare-directory default-directory)\"\n\n$(PKG)-autoloads.el: $(ELS)\n\t@printf \" Creating $@\\n\"\n\t@$(EMACS_BATCH) --load autoload --eval \"\\\n(let* ((file (expand-file-name \\\"$@\\\"))\\\n (generated-autoload-file file)\\\n (coding-system-for-write 'utf-8-emacs-unix)\\\n (backup-inhibited t)\\\n (version-control 'never)\\\n (inhibit-message t))\\\n (write-region (autoload-rubric file \\\"package\\\" t) nil file)\\\n (update-directory-autoloads default-directory))\" \\\n\t2>&1 | sed \"/^Package autoload is deprecated$$/d\"\n" }, { "path": "README.md", "content": "# EmacSQL\n\nEmacSQL is a high-level Emacs Lisp front-end for SQLite.\n\nPostgreSQL and MySQL are also supported, but use of these connectors\nis not recommended.\n\nAny [readable lisp value][readable] can be stored as a value in\nEmacSQL, including numbers, strings, symbols, lists, vectors, and\nclosures. EmacSQL has no concept of \"TEXT\" values; it's all just lisp\nobjects. The lisp object `nil` corresponds 1:1 with `NULL` in the\ndatabase.\n\nRequires Emacs 26 or later.\n\n[![Compile](https://github.com/magit/emacsql/actions/workflows/compile.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/compile.yml)\n[![Test](https://github.com/magit/emacsql/actions/workflows/test.yml/badge.svg)](https://github.com/magit/emacsql/actions/workflows/test.yml)\n[![NonGNU ELPA](https://emacsair.me/assets/badges/nongnu-elpa.svg)](https://elpa.nongnu.org/nongnu-devel/emacsql.html)\n[![MELPA Stable](https://stable.melpa.org/packages/emacsql-badge.svg)](https://stable.melpa.org/#/emacsql)\n[![MELPA](https://melpa.org/packages/emacsql-badge.svg)](https://melpa.org/#/emacsql)\n\n### FAQ\n#### Why are all values stored as strings?\n\nEmacSQL is not intended to interact with arbitrary databases, but to\nbe an ACID-compliant database for Emacs extensions. This means that\nEmacSQL cannot be used with a regular SQL database used by other\nnon-Emacs clients.\n\nAll database values must be s-expressions. When EmacSQL stores a\nvalue — string, symbol, cons, etc. — it is printed and written to\nthe database in its printed form. Strings are wrapped in quotes\nand escaped as necessary. That means \"bare\" symbols in the database\ngenerally look like strings. The only exception is `nil`, which is\nstored as `NULL`.\n\n#### Will EmacSQL ever support arbitrary databases?\n\nThe author of EmacSQL [thinks][mistake] that it was probably a\ndesign mistake to restrict it to Emacs by storing only printed values,\nand that it would be a lot more useful if it just handled primitive\ndatabase types.\n\nHowever, EmacSQL is in maintenance mode and there are no plans to\nmake any fundamental changes, not least because they would break all\nexisting packages and databases that rely on the current EmacSQL\nbehavior.\n\n### Windows Issues\n\nEmacs `start-process-shell-command` function is not supported on\nWindows. Since both `emacsql-mysql` and `emacsql-psql` rely on this\nfunction, neither of these connection types are supported on Windows.\n\n## Example Usage\n\n```el\n(defvar db (emacsql-sqlite-open \"~/company.db\"))\n\n;; Create a table. Table and column identifiers are symbols.\n(emacsql db [:create-table people ([name id salary])])\n\n;; Or optionally provide column constraints.\n(emacsql db [:create-table people\n ([name (id integer :primary-key) (salary float)])])\n\n;; Insert some data:\n(emacsql db [:insert :into people\n :values ([\"Jeff\" 1000 60000.0] [\"Susan\" 1001 64000.0])])\n\n;; Query the database for results:\n(emacsql db [:select [name id]\n :from people\n :where (> salary 62000)])\n;; => ((\"Susan\" 1001))\n\n;; Queries can be templates, using $1, $2, etc.:\n(emacsql db [:select [name id]\n :from people\n :where (> salary $s1)]\n 50000)\n;; => ((\"Jeff\" 1000) (\"Susan\" 1001))\n```\n\nWhen editing these prepared SQL s-expression statements, the `M-x\nemacsql-show-last-sql` command (think `eval-last-sexp`) is useful for\nseeing what the actual SQL expression will become when compiled.\n\n## Schema\n\nA table schema is a list whose first element is a vector of column\nspecifications. The rest of the list specifies table constraints. A\ncolumn identifier is a symbol and a column's specification can either\nbe just this symbol or it can include constraints as a list. Because\nEmacSQL stores entire lisp objects as values, the only relevant (and\nallowed) types are `integer`, `float`, and `object` (default).\n\n ([() ...] ( ...) ...])\n\nDashes in identifiers are converted into underscores when compiled\ninto SQL. This allows for lisp-style identifiers to be used in SQL.\nConstraints follow the compilation rules below.\n\n```el\n;; No constraints schema with four columns:\n([name id building room])\n\n;; Add some column constraints:\n([(name :unique) (id integer :primary-key) building room])\n\n;; Add some table constraints:\n([(name :unique) (id integer :primary-key) building room]\n (:unique [building room])\n (:check (> id 0)))\n```\n\nHere's an example using foreign keys.\n\n```el\n;; \"subjects\" table schema\n([(id integer :primary-key) subject])\n\n;; \"tag\" table references subjects\n([(subject-id integer) tag]\n (:foreign-key [subject-id] :references subjects [id]\n :on-delete :cascade))\n```\n\nForeign key constraints are enabled by default in EmacSQL.\n\n## Operators\n\nExpressions are written lisp-style, with the operator first. If it\nlooks like an operator EmacSQL treats it like an operator. However,\nseveral operators are special.\n\n <= >= funcall quote\n\nThe `<=` and `>=` operators accept 2 or 3 operands, transforming into\na SQL `_ BETWEEN _ AND _` operator as appropriate.\n\nFor function-like \"operators\" like `count` and `max` use the `funcall`\n\"operator.\"\n\n```el\n[:select (funcall max age) :from people]\n```\n\nWith `glob` and `like` SQL operators keep in mind that they're\nmatching the *printed* representations of these values, even if the\nvalue is a string.\n\nThe `||` concatenation operator is unsupported because concatenating\nprinted representations breaks an important constraint: all values must\nremain readable within SQLite.\n\n## Quoting\n\nInside expressions, EmacSQL cannot tell the difference between symbol\nliterals and column references. If you're talking about the symbol\nitself, just quote it as you would in normal Elisp. Note that this\ndoes not \"escape\" `$tn` parameter symbols.\n\n```el\n(emacsql db [... :where (= category 'hiking)])\n```\n\nQuoting a string makes EmacSQL handle it as a \"raw string.\" These raw\nstrings are not printed when being assembled into a query. These are\nintended for use in special circumstances like filenames (`ATTACH`) or\npattern matching (`LIKE`). It is vital that raw strings are not\nreturned as results.\n\n```el\n(emacsql db [... :where (like name '\"%foo%\")])\n(emacsql db [:attach '\"/path/to/foo.db\" :as foo])\n```\n\nSince template parameters include their type they never need to be\nquoted.\n\n## Prepared Statements\n\nThe database is interacted with via prepared SQL s-expression\nstatements. You shouldn't normally be concatenating strings on your\nown. (And it leaves out any possibility of a SQL injection!) See the\n\"Usage\" section above for examples. A statement is a vector of\nkeywords and other lisp object.\n\nPrepared EmacSQL s-expression statements are compiled into SQL\nstatements. The statement compiler is memorized so that using the same\nstatement multiple times is fast. To assist in this, the statement can\nact as a template -- using `$i1`, `$s2`, etc. -- working like the\nElisp `format` function.\n\n### Compilation Rules\n\nRather than the typical uppercase SQL keywords, keywords in a prepared\nEmacSQL statement are literally just that: lisp keywords. EmacSQL only\nunderstands a very small amount of SQL's syntax. The compiler follows\nsome simple rules to convert an s-expression into SQL.\n\n#### All prepared statements are vectors.\n\nA prepared s-expression statement is a vector beginning with a keyword\nfollowed by a series of keywords and special values. This includes\nmost kinds of sub-queries.\n\n```el\n[:select ... :from ...]\n[:select tag :from tags\n :where (in tag [:select ...])]\n```\n\n#### Keywords are split and capitalized.\n\nDashes are converted into spaces and the keyword gets capitalized. For\nexample, `:if-not-exists` becomes `IF NOT EXISTS`. How you choose to\ncombine keywords is up to your personal taste (e.g., `:drop :table` vs.\n`:drop-table`).\n\n#### Standalone symbols are identifiers.\n\nEmacSQL doesn't know what symbols refer to identifiers and what\nsymbols should be treated as values. Use quotes to mark a symbol as a\nvalue. For example, `people` here will be treated as an identifier.\n\n```el\n[:insert-into people :values ...]\n```\n\n#### Row-oriented information is always represented as vectors.\n\nThis includes rows being inserted, and sets of columns in a query. If\nyou're talking about a row-like thing then put it in a vector.\n\n```el\n[:select [id name] :from people]\n```\n\nNote that `*` is actually a SQL keyword, so don't put it in a vector.\n\n```el\n[:select * :from ...]\n```\n\n#### Lists are treated as expressions.\n\nThis is true even within row-oriented vectors.\n\n```el\n[... :where (= name \"Bob\")]\n[:select [(/ seconds 60) count] :from ...]\n```\n\nSome things that are traditionally keywords -- particularly those that\nare mixed in with expressions -- have been converted into operators\n(`AS`, `ASC`, `DESC`).\n\n```el\n[... :order-by [(asc b), (desc a)]] ; \"ORDER BY b ASC, a DESC\"\n[:select p:name :from (as people p)] ; \"SELECT p.name FROM people AS p\"\n```\n\n#### The `:values` keyword is special.\n\nWhat follows `:values` is always treated like a vector or list of\nvectors. Normally this sort of thing would appear to be a column\nreference.\n\n```el\n[... :values [1 2 3]]\n[... :values ([1 2 3] [4 5 6])] ; insert multiple rows\n```\n\n#### A list whose first element is a vector is a table schema.\n\nThis is to distinguish schemata from everything else. With the\nexception of what follows `:values`, nothing else is shaped like this.\n\n```el\n[:create-table people ([(id :primary-key) name])]\n```\n\n### Templates\n\nTo make statement compilation faster, and to avoid making you build up\nstatements dynamically, you can insert `$tn` parameters in place of\nidentifiers and values. These refer to the argument's type and its\nargument position after the statement in the `emacsql` function,\none-indexed.\n\n```el\n(emacsql db [:select * :from $i1 :where (> salary $s2)] 'employees 50000)\n\n(emacsql db [:select * :from employees :where (like name $r1)] \"%Smith%\")\n```\n\nThe letter before the number is the type.\n\n * `i` : identifier\n * `s` : scalar\n * `v` : vector (or multiple vectors)\n * `r` : raw, unprinted strings\n * `S` : schema\n\nWhen combined with `:values`, the vector type can refer to lists of\nrows.\n\n```el\n(emacsql db [:insert-into favorite-characters :values $v1]\n '([0 \"Calvin\"] [1 \"Hobbes\"] [3 \"Susie\"]))\n```\n\nThis is why rows must be vectors and not lists.\n\n### Ignored Features\n\nEmacSQL doesn't cover all of SQLite's features. Here are a list of\nthings that aren't supported, and probably will never be.\n\n * Collating. SQLite has three built-in collation functions: BINARY\n (default), NOCASE, and RTRIM. EmacSQL values never have right-hand\n whitespace, so RTRIM won't be of any use. NOCASE is broken\n (ASCII-only) and there's little reason to use it.\n\n * Text manipulation functions. Like collating this is incompatible\n with EmacSQL s-expression storage.\n\n * Date and time. These are incompatible with the printed values\n stored by EmacSQL and therefore have little use.\n\n## Limitations\n\nEmacSQL is *not* intended to play well with other programs accessing\nthe SQLite database. Non-numeric values are stored encoded as\ns-expressions TEXT values. This avoids ambiguities in parsing output\nfrom the command line and allows for storage of Emacs richer data\ntypes. This is an efficient, ACID-compliant database specifically for\nEmacs.\n\n## Emacs Lisp Indentation Annoyance\n\nBy default, `emacs-lisp-mode` indents vectors as if they were regular\nfunction calls.\n\n```el\n;; Ugly indentation!\n(emacsql db [:select *\n :from people\n :where (> age 60)])\n```\n\nCalling the function `emacsql-fix-vector-indentation` (interactive)\nadvises the major mode to fix this annoyance.\n\n```el\n;; Such indent!\n(emacsql db [:select *\n :from people\n :where (> age 60)])\n```\n\n## Contributing and Extending\n\nTo run the test suite, clone the `pg` and `sqlite3` packages into\nsibling directories. The Makefile will automatically put these paths on\nthe Emacs load path (override `LDFLAGS` if your situation is different).\n\n```shell\ngit clone https://github.com/emarsden/pg-el ../pg\ngit clone https://github.com/pekingduck/emacs-sqlite3-api ../sqlite3\n```\n\nOr set `LOAD_PATH` to point at these packages elsewhere:\n\n```shell\nmake LOAD_PATH='-L path/to/pg -L path/to/sqlite3'\n```\n\nThen invoke make:\n\n```shell\nmake test\n```\n\nIf the environment variable `PGDATABASE` is present then the unit\ntests will also be run with PostgreSQL (emacsql-psql). Provide\n`PGHOST`, `PGPORT`, and `PGUSER` if needed. If `PGUSER` is provided,\nthe pg.el back-end (emacsql-pg) will also be tested.\n\nIf the environment variable `MYSQL_DBNAME` is present then the unit\ntests will also be run with MySQL in the named database. Note that\nthis is not an official MySQL variable, just something made up for\nEmacSQL.\n\n### Creating a New Front-end\n\nEmacSQL uses EIEIO so that interactions with a connection occur\nthrough generic functions. You need to define a new class that\ninherits from `emacsql-connection`.\n\n * Implement `emacsql-send-message`, `emacsql-waiting-p`,\n `emacsql-parse`, and `emacsql-close`.\n * Provide a constructor that initializes the connection and calls\n `emacsql-register` (for automatic connection cleanup).\n * Provide `emacsql-types` if needed (hint: use a class-allocated slot).\n * Ensure that you properly read NULL as nil (hint: ask your back-end\n to print it that way).\n * Register all reserved words with `emacsql-register-reserved`.\n * Preferably provide `emacsql-reconnect` if possible.\n * Set the default isolation level to *serializable*.\n * Enable autocommit mode by default.\n * Prefer ANSI syntax (value escapes, identifier escapes, etc.).\n * Enable foreign key constraints by default.\n\nThe goal of the autocommit, isolation, parsing, and foreign key\nconfiguration settings is to normalize the interface as much as\npossible. The connection's user should have the option to be agnostic\nabout which back-end is actually in use.\n\nThe provided implementations should serve as useful examples. If your\nback-end outputs data in a clean, standard way you may be able to use\nthe emacsql-protocol-mixin class to do most of the work.\n\n## See Also\n\n * [SQLite Documentation](https://www.sqlite.org/docs.html)\n\n[readable]: http://nullprogram.com/blog/2013/12/30/#almost_everything_prints_readably\n[mistake]: https://github.com/magit/emacsql/issues/35#issuecomment-346352439\n\n\n\n" }, { "path": "UNLICENSE", "content": "This is free and unencumbered software released into the public domain.\n\nAnyone is free to copy, modify, publish, use, compile, sell, or\ndistribute this software, either in source code form or as a compiled\nbinary, for any purpose, commercial or non-commercial, and by any\nmeans.\n\nIn jurisdictions that recognize copyright laws, the author or authors\nof this software dedicate any and all copyright interest in the\nsoftware to the public domain. We make this dedication for the benefit\nof the public at large and to the detriment of our heirs and\nsuccessors. We intend this dedication to be an overt act of\nrelinquishment in perpetuity of all present and future rights to this\nsoftware under copyright law.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,\nEXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF\nMERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.\nIN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR\nOTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,\nARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR\nOTHER DEALINGS IN THE SOFTWARE.\n\nFor more information, please refer to \n" }, { "path": "default.mk", "content": "TOP := $(dir $(lastword $(MAKEFILE_LIST)))\n\nDOMAIN ?= magit.vc\n\nPKG = emacsql\n\nELS = $(PKG)-compiler.el\nELS += $(PKG).el\nELS += $(PKG)-sqlite.el\nELS += $(PKG)-sqlite-builtin.el\nELS += $(PKG)-sqlite-module.el\nELS += $(PKG)-mysql.el\nELS += $(PKG)-psql.el\nELS += $(PKG)-pg.el\nELCS = $(ELS:.el=.elc)\n\nDEPS = pg\nDEPS += peg\nDEPS += sqlite3\n\nLOAD_PATH ?= $(addprefix -L ../,$(DEPS))\nLOAD_PATH += -L .\nLOAD_PATH += -L ./test\n\nifeq ($(CI), true)\n# Workaround for bug#58252 on Emacs 28.x.\noverride EMACS_ARGS += --eval \"(setq byte-compile-docstring-max-column 120)\"\nelse\nEMACS_ARGS ?=\nendif\n\nEMACS ?= emacs\nEMACS_Q_ARG ?= -Q\nEMACS_BATCH ?= $(EMACS) $(EMACS_Q_ARG) --batch $(EMACS_ARGS) $(LOAD_PATH)\nEMACS_INTR ?= $(EMACS) $(EMACS_Q_ARG) $(EMACS_ARGS) $(LOAD_PATH)\n\nGITSTATS ?= gitstats\nGITSTATS_DIR ?= stats\nGITSTATS_ARGS ?= -c style=https://magit.vc/assets/stats.css -c max_authors=999\n\nRCLONE ?= rclone\nRCLONE_ARGS ?= -v\n\nifdef NIX_PATH\nexport SQLITE3_API_BUILD_COMMAND = nix-shell -p sqlite.dev --run \"make all\"\nendif\n" }, { "path": "docs/Makefile", "content": "-include ../config.mk\ninclude ../default.mk\n\n.PHONY: stats\n\nSTAT_DOMAIN = stats.$(DOMAIN)\nSTAT_TARGET = $(subst .,_,$(STAT_DOMAIN)):$(PKG)/\n\nstats:\n\t@printf \"Generating statistics...\\n\"\n\t@$(GITSTATS) $(GITSTATS_ARGS) $(TOP) $(GITSTATS_DIR)\n\nstats-upload:\n\t@printf \"Uploading statistics...\\n\"\n\t@$(RCLONE) sync $(RCLONE_ARGS) stats $(STAT_TARGET)\n\nCLEAN = $(GITSTATS_DIR)\n\nclean:\n\t@printf \" Cleaning docs/*...\\n\"\n\t@rm -rf $(CLEAN)\n" }, { "path": "emacsql-compiler.el", "content": ";;; emacsql-compiler.el --- S-expression SQL compiler -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Christopher Wellons \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides support for compiling S-expressions to SQL.\n\n;;; Code:\n\n(require 'cl-lib)\n\n(eval-when-compile (require 'subr-x))\n\n;;; Error symbols\n\n(defmacro emacsql-deferror (symbol parents message)\n \"Defines a new error symbol for EmacSQL.\"\n (declare (indent 2))\n (let ((conditions (cl-remove-duplicates\n (append parents (list symbol 'emacsql-error 'error)))))\n `(prog1 ',symbol\n (put ',symbol 'error-conditions ',conditions)\n (put ',symbol 'error-message ,message))))\n\n(emacsql-deferror emacsql-error () ;; parent condition for all others\n \"EmacSQL had an unhandled condition\")\n\n(emacsql-deferror emacsql-syntax () \"Invalid SQL statement\")\n(emacsql-deferror emacsql-internal () \"Internal error\")\n(emacsql-deferror emacsql-locked () \"Database locked\")\n(emacsql-deferror emacsql-fatal () \"Fatal error\")\n(emacsql-deferror emacsql-memory () \"Out of memory\")\n(emacsql-deferror emacsql-corruption () \"Database corrupted\")\n(emacsql-deferror emacsql-access () \"Database access error\")\n(emacsql-deferror emacsql-timeout () \"Query timeout error\")\n(emacsql-deferror emacsql-warning () \"Warning message\")\n\n(defun emacsql-error (format &rest args)\n \"Like `error', but signal an emacsql-syntax condition.\"\n (signal 'emacsql-syntax (list (apply #'format format args))))\n\n;;; Escaping functions\n\n(defvar emacsql-reserved (make-hash-table :test 'equal)\n \"Collection of all known reserved words, used for escaping.\")\n\n(defun emacsql-register-reserved (seq)\n \"Register sequence of keywords as reserved words, returning SEQ.\"\n (cl-loop for word being the elements of seq\n do (setf (gethash (upcase (format \"%s\" word)) emacsql-reserved) t)\n finally (cl-return seq)))\n\n(defun emacsql-reserved-p (name)\n \"Returns non-nil if string NAME is a SQL keyword.\"\n (gethash (upcase name) emacsql-reserved))\n\n(defun emacsql-quote-scalar (string)\n \"Single-quote (scalar) STRING for use in a SQL expression.\"\n (with-temp-buffer\n (insert string)\n (goto-char (point-min))\n (while (re-search-forward \"'\" nil t)\n (replace-match \"''\"))\n (goto-char (point-min))\n (insert \"'\")\n (goto-char (point-max))\n (insert \"'\")\n (buffer-string)))\n\n(defun emacsql-quote-character (c)\n \"Single-quote character C for use in a SQL expression.\"\n (if (char-equal c ?')\n \"''''\"\n (format \"'%c'\" c)))\n\n(defun emacsql-quote-identifier (string)\n \"Double-quote (identifier) STRING for use in a SQL expression.\"\n (format \"\\\"%s\\\"\" (replace-regexp-in-string \"\\\"\" \"\\\"\\\"\" string)))\n\n(defun emacsql-escape-identifier (identifier)\n \"Escape an identifier, if needed, for SQL.\"\n (when (or (null identifier)\n (keywordp identifier)\n (not (or (symbolp identifier)\n (vectorp identifier))))\n (emacsql-error \"Invalid identifier: %S\" identifier))\n (cond\n ((vectorp identifier)\n (mapconcat #'emacsql-escape-identifier identifier \", \"))\n ((eq identifier '*) \"*\")\n (t\n (let ((name (symbol-name identifier)))\n (if (string-match-p \":\" name)\n (mapconcat #'emacsql-escape-identifier\n (mapcar #'intern (split-string name \":\")) \".\")\n (let ((print (replace-regexp-in-string \"-\" \"_\" (format \"%S\" identifier)))\n (special \"[]-\\000-\\040!\\\"#%&'()*+,./:;<=>?@[\\\\^`{|}~\\177]\"))\n (if (or (string-match-p special print)\n (string-match-p \"^[0-9$]\" print)\n (emacsql-reserved-p print))\n (emacsql-quote-identifier print)\n print)))))))\n\n(defvar print-escape-control-characters)\n\n(defun emacsql-escape-scalar (value)\n \"Escape VALUE for sending to SQLite.\"\n (let ((print-escape-newlines t)\n (print-escape-control-characters t))\n (cond ((null value) \"NULL\")\n ((numberp value) (prin1-to-string value))\n ((emacsql-quote-scalar (prin1-to-string value))))))\n\n(defun emacsql-escape-raw (value)\n \"Escape VALUE for sending to SQLite.\"\n (cond ((null value) \"NULL\")\n ((stringp value) (emacsql-quote-scalar value))\n ((error \"Expected string or nil\"))))\n\n(defun emacsql-escape-vector (vector)\n \"Encode VECTOR into a SQL vector scalar.\"\n (cl-typecase vector\n (null (emacsql-error \"Empty SQL vector expression\"))\n (list (mapconcat #'emacsql-escape-vector vector \", \"))\n (vector (concat \"(\" (mapconcat #'emacsql-escape-scalar vector \", \") \")\"))\n (otherwise (emacsql-error \"Invalid vector %S\" vector))))\n\n(defun emacsql-escape-format (thing)\n \"Escape THING for use as a `format' spec.\"\n (replace-regexp-in-string \"%\" \"%%\" thing))\n\n;;; Schema compiler\n\n(defvar emacsql-type-map\n '((integer \"&INTEGER\")\n (float \"&REAL\")\n (object \"&TEXT\")\n (nil \"&NONE\"))\n \"An alist mapping EmacSQL types to SQL types.\")\n\n(defun emacsql--from-keyword (keyword)\n \"Convert KEYWORD into SQL.\"\n (let ((name (substring (symbol-name keyword) 1)))\n (upcase (replace-regexp-in-string \"-\" \" \" name))))\n\n(defun emacsql--prepare-constraints (constraints)\n \"Compile CONSTRAINTS into a partial SQL expression.\"\n (mapconcat\n #'identity\n (cl-loop for constraint in constraints collect\n (cl-typecase constraint\n (null \"NULL\")\n (keyword (emacsql--from-keyword constraint))\n (symbol (emacsql-escape-identifier constraint))\n (vector (format \"(%s)\"\n (mapconcat\n #'emacsql-escape-identifier\n constraint\n \", \")))\n (list (format \"(%s)\"\n (car (emacsql--*expr constraint))))\n (otherwise\n (emacsql-escape-scalar constraint))))\n \" \"))\n\n(defun emacsql--prepare-column (column)\n \"Convert COLUMN into a partial SQL string.\"\n (mapconcat\n #'identity\n (cl-etypecase column\n (symbol (list (emacsql-escape-identifier column)\n (cadr (assoc nil emacsql-type-map))))\n (list (cl-destructuring-bind (name . constraints) column\n (cl-delete-if\n (lambda (s) (zerop (length s)))\n (list (emacsql-escape-identifier name)\n (if (member (car constraints) '(integer float object))\n (cadr (assoc (pop constraints) emacsql-type-map))\n (cadr (assoc nil emacsql-type-map)))\n (emacsql--prepare-constraints constraints))))))\n \" \"))\n\n(defun emacsql-prepare-schema (schema)\n \"Compile SCHEMA into a SQL string.\"\n (if (vectorp schema)\n (emacsql-prepare-schema (list schema))\n (cl-destructuring-bind (columns . constraints) schema\n (mapconcat\n #'identity\n (nconc\n (mapcar #'emacsql--prepare-column columns)\n (mapcar #'emacsql--prepare-constraints constraints))\n \", \"))))\n\n;;; Statement compilation\n\n(defvar emacsql-prepare-cache (make-hash-table :test 'equal :weakness 'key)\n \"Cache used to memoize `emacsql-prepare'.\")\n\n(defvar emacsql--vars ()\n \"Used within `emacsql-with-params' to collect parameters.\")\n\n(defun emacsql-sql-p (thing)\n \"Return non-nil if THING looks like a prepared statement.\"\n (and (vectorp thing) (> (length thing) 0) (keywordp (aref thing 0))))\n\n(defun emacsql-param (thing)\n \"Return the index and type of THING, or nil if THING is not a parameter.\nA parameter is a symbol that looks like $i1, $s2, $v3, etc. The\nletter refers to the type: identifier (i), scalar (s),\nvector (v), raw string (r), schema (S).\"\n (and (symbolp thing)\n (let ((name (symbol-name thing)))\n (and (string-match-p \"^\\\\$[isvrS][0-9]+$\" name)\n (cons (1- (read (substring name 2)))\n (cl-ecase (aref name 1)\n (?i :identifier)\n (?s :scalar)\n (?v :vector)\n (?r :raw)\n (?S :schema)))))))\n\n(defmacro emacsql-with-params (prefix &rest body)\n \"Evaluate BODY, collecting parameters.\nProvided local functions: `param', `identifier', `scalar', `raw',\n`svector', `expr', `subsql', and `combine'. BODY should return a\nstring, which will be combined with variable definitions.\"\n (declare (indent 1))\n `(let ((emacsql--vars ()))\n (cl-flet* ((combine (prepared) (emacsql--*combine prepared))\n (param (thing) (emacsql--!param thing))\n (identifier (thing) (emacsql--!param thing :identifier))\n (scalar (thing) (emacsql--!param thing :scalar))\n (raw (thing) (emacsql--!param thing :raw))\n (svector (thing) (combine (emacsql--*vector thing)))\n (expr (thing) (combine (emacsql--*expr thing)))\n (subsql (thing)\n (format \"(%s)\" (combine (emacsql-prepare thing)))))\n (cons (concat ,prefix (progn ,@body)) emacsql--vars))))\n\n(defun emacsql--!param (thing &optional kind)\n \"Parse, escape, and store THING.\nIf optional KIND is not specified, then try to guess it.\nOnly use within `emacsql-with-params'!\"\n (cl-flet ((check (param)\n (when (and kind (not (eq kind (cdr param))))\n (emacsql-error\n \"Invalid parameter type %s, expecting %s\" thing kind))))\n (let ((param (emacsql-param thing)))\n (if (null param)\n (emacsql-escape-format\n (if kind\n (cl-case kind\n (:identifier (emacsql-escape-identifier thing))\n (:scalar (emacsql-escape-scalar thing))\n (:vector (emacsql-escape-vector thing))\n (:raw (emacsql-escape-raw thing))\n (:schema (emacsql-prepare-schema thing)))\n (if (and (not (null thing))\n (not (keywordp thing))\n (symbolp thing))\n (emacsql-escape-identifier thing)\n (emacsql-escape-scalar thing))))\n (prog1 (if (eq (cdr param) :schema) \"(%s)\" \"%s\")\n (check param)\n (setq emacsql--vars (nconc emacsql--vars (list param))))))))\n\n(defun emacsql--*vector (vector)\n \"Prepare VECTOR.\"\n (emacsql-with-params \"\"\n (cl-typecase vector\n (symbol (emacsql--!param vector :vector))\n (list (mapconcat #'svector vector \", \"))\n (vector (format \"(%s)\" (mapconcat #'scalar vector \", \")))\n (otherwise (emacsql-error \"Invalid vector: %S\" vector)))))\n\n(defmacro emacsql--generate-op-lookup-defun (name operator-precedence-groups)\n \"Generate function to look up predefined SQL operator metadata.\n\nThe generated function is bound to NAME and accepts two\narguments, OPERATOR-NAME and OPERATOR-ARGUMENT-COUNT.\nOPERATOR-PRECEDENCE-GROUPS should be a number of lists containing\noperators grouped by operator precedence (in order of precedence\nfrom highest to lowest). A single operator is represented by a\nlist of at least two elements: operator name (symbol) and\noperator arity (:unary or :binary). Optionally a custom\nexpression can be included, which defines how the operator is\nexpanded into an SQL expression (there are two defaults, one for\n:unary and one for :binary operators).\n\nAn example for OPERATOR-PRECEDENCE-GROUPS:\n\\(((+ :unary (\\\"+\\\" :operand)) (- :unary (\\\"-\\\" :operand)))\n ((+ :binary) (- :binary)))\"\n `(defun ,name (operator-name operator-argument-count)\n \"Look up predefined SQL operator metadata.\nSee `emacsql--generate-op-lookup-defun' for details.\"\n (cond\n ,@(cl-loop\n for precedence-value from 1\n for precedence-group in (reverse operator-precedence-groups)\n append (cl-loop\n for (op-name arity custom-expr) in precedence-group\n for sql-name = (upcase (symbol-name op-name))\n for sql-expr =\n (or custom-expr\n (pcase arity\n (:unary `(,sql-name \" \" :operand))\n (:binary `(:operand \" \" ,sql-name \" \" :operand))))\n\n collect (list `(and (eq operator-name\n (quote ,op-name))\n ,(if (eq arity :unary)\n `(eql operator-argument-count 1)\n `(>= operator-argument-count 2)))\n `(list ',sql-expr ,arity ,precedence-value))))\n (t (list nil nil nil)))))\n\n(emacsql--generate-op-lookup-defun\n emacsql--get-op\n (((~ :unary (\"~\" :operand)))\n ((collate :binary))\n ((|| :binary))\n ((* :binary) (/ :binary) (% :binary))\n ((+ :unary (\"+\" :operand)) (- :unary (\"-\" :operand)))\n ((+ :binary) (- :binary))\n ((& :binary) (| :binary) (<< :binary) (>> :binary))\n ((escape :binary (:operand \" ESCAPE \" :operand)))\n ((< :binary) (<= :binary) (> :binary) (>= :binary))\n\n (;;TODO? (between :binary) (not-between :binary)\n (is :binary) (is-not :binary (:operand \" IS NOT \" :operand))\n (match :binary) (not-match :binary (:operand \" NOT MATCH \" :operand))\n (like :binary) (not-like :binary (:operand \" NOT LIKE \" :operand))\n (in :binary) (not-in :binary (:operand \" NOT IN \" :operand))\n (isnull :unary (:operand \" ISNULL\"))\n (notnull :unary (:operand \" NOTNULL\"))\n (= :binary) (== :binary)\n (!= :binary) (<> :binary)\n (glob :binary) (not-glob :binary (:operand \" NOT GLOB \" :operand))\n (regexp :binary) (not-regexp :binary (:operand \" NOT REGEXP \" :operand)))\n\n ((not :unary))\n ((and :binary))\n ((or :binary))))\n\n(defun emacsql--expand-format-string (op expr arity argument-count)\n \"Create format-string for an SQL operator.\nThe format-string returned is intended to be used with `format'\nto create an SQL expression.\"\n (and expr\n (cl-labels ((replace-operand (x) (if (eq x :operand) \"%s\" x))\n (to-format-string (e) (mapconcat #'replace-operand e \"\")))\n (cond\n ((and (eq arity :unary) (eql argument-count 1))\n (to-format-string expr))\n ((and (eq arity :binary) (>= argument-count 2))\n (let ((result (reverse expr)))\n (dotimes (_ (- argument-count 2))\n (setq result (nconc (reverse expr) (cdr result))))\n (to-format-string (nreverse result))))\n (t (emacsql-error \"Wrong number of operands for %s\" op))))))\n\n(defun emacsql--get-op-info (op argument-count parent-precedence-value)\n \"Lookup SQL operator information for generating an SQL expression.\nReturns the following multiple values when an operator can be\nidentified: a format string (see `emacsql--expand-format-string')\nand a precedence value. If PARENT-PRECEDENCE-VALUE is greater or\nequal to the identified operator's precedence, then the format\nstring returned is wrapped with parentheses.\"\n (cl-destructuring-bind (format-string arity precedence-value)\n (emacsql--get-op op argument-count)\n (let ((expanded-format-string\n (emacsql--expand-format-string\n op\n format-string\n arity\n argument-count)))\n (cl-values (cond\n ((null format-string) nil)\n ((>= parent-precedence-value\n precedence-value)\n (format \"(%s)\" expanded-format-string))\n (t expanded-format-string))\n precedence-value))))\n\n(defun emacsql--*expr (expr &optional parent-precedence-value)\n \"Expand EXPR recursively.\"\n (emacsql-with-params \"\"\n (cond\n ((emacsql-sql-p expr) (subsql expr))\n ((vectorp expr) (svector expr))\n ((atom expr) (param expr))\n ((cl-destructuring-bind (op . args) expr\n (cl-multiple-value-bind (format-string precedence-value)\n (emacsql--get-op-info op\n (length args)\n (or parent-precedence-value 0))\n (cl-flet ((recur (n)\n (combine (emacsql--*expr (nth n args)\n (or precedence-value 0))))\n (nops (op)\n (emacsql-error \"Wrong number of operands for %s\" op)))\n (cl-case op\n ;; Special cases <= >=\n ((<= >=)\n (cl-case (length args)\n (2 (format format-string (recur 0) (recur 1)))\n (3 (format (if (>= (or parent-precedence-value 0)\n precedence-value)\n \"(%s BETWEEN %s AND %s)\"\n \"%s BETWEEN %s AND %s\")\n (recur 1)\n (recur (if (eq op '>=) 2 0))\n (recur (if (eq op '>=) 0 2))))\n (otherwise (nops op))))\n ;; enforce second argument to be a character\n ((escape)\n (let ((second-arg (cadr args)))\n (cond\n ((not (= 2 (length args))) (nops op))\n ((not (characterp second-arg))\n (emacsql-error\n \"Second operand of escape has to be a character, got %s\"\n second-arg))\n (t (format format-string\n (recur 0)\n (emacsql-quote-character second-arg))))))\n ;; Ordering\n ((asc desc)\n (format \"%s %s\" (recur 0) (upcase (symbol-name op))))\n ;; Special case quote\n ((quote) (let ((arg (nth 0 args)))\n (if (stringp arg)\n (raw arg)\n (scalar arg))))\n ;; Special case funcall\n ((funcall)\n (format \"%s(%s)\" (recur 0)\n (cond\n ((and (= 2 (length args))\n (eq '* (nth 1 args)))\n \"*\")\n ((and (= 3 (length args))\n (eq :distinct (nth 1 args))\n (format \"DISTINCT %s\" (recur 2))))\n ((mapconcat\n #'recur (cl-loop for i from 1 below (length args)\n collect i)\n \", \")))))\n ;; Guess\n (otherwise\n (let ((arg-indices (cl-loop for i from 0 below (length args) collect i)))\n (if format-string\n (apply #'format format-string (mapcar #'recur arg-indices))\n (mapconcat\n #'recur (cl-loop for i from 0 below (length args) collect i)\n (format \" %s \" (upcase (symbol-name op)))))))))))))))\n\n(defun emacsql--*idents (idents)\n \"Read in a vector of IDENTS identifiers, or just an single identifier.\"\n (emacsql-with-params \"\"\n (mapconcat #'expr idents \", \")))\n\n(defun emacsql--*combine (prepared)\n \"Append parameters from PREPARED to `emacsql--vars', return the string.\nOnly use within `emacsql-with-params'!\"\n (cl-destructuring-bind (string . vars) prepared\n (setq emacsql--vars (nconc emacsql--vars vars))\n string))\n\n(defun emacsql-prepare--string (string)\n \"Create a prepared statement from STRING.\"\n (emacsql-with-params \"\"\n (replace-regexp-in-string\n \"\\\\$[isv][0-9]+\" (lambda (v) (param (intern v))) string)))\n\n(defun emacsql-prepare--sexp (sexp)\n \"Create a prepared statement from SEXP.\"\n (emacsql-with-params \"\"\n (cl-loop with items = (cl-coerce sexp 'list)\n and last = nil\n while (not (null items))\n for item = (pop items)\n collect\n (cl-typecase item\n (keyword (if (eq :values item)\n (concat \"VALUES \" (svector (pop items)))\n (emacsql--from-keyword item)))\n (symbol (if (eq item '*)\n \"*\"\n (param item)))\n (vector (if (emacsql-sql-p item)\n (subsql item)\n (let ((idents (combine\n (emacsql--*idents item))))\n (if (keywordp last)\n idents\n (format \"(%s)\" idents)))))\n (list (if (vectorp (car item))\n (emacsql-escape-format\n (format \"(%s)\"\n (emacsql-prepare-schema item)))\n (combine (emacsql--*expr item))))\n (otherwise\n (emacsql-escape-format\n (emacsql-escape-scalar item))))\n into parts\n do (setq last item)\n finally (cl-return (string-join parts \" \")))))\n\n(defun emacsql-prepare (sql)\n \"Expand SQL (string or sexp) into a prepared statement.\"\n (let* ((cache emacsql-prepare-cache)\n (key (cons emacsql-type-map sql)))\n (or (gethash key cache)\n (setf (gethash key cache)\n (if (stringp sql)\n (emacsql-prepare--string sql)\n (emacsql-prepare--sexp sql))))))\n\n(defun emacsql-format (expansion &rest args)\n \"Fill in the variables EXPANSION with ARGS.\"\n (cl-destructuring-bind (format . vars) expansion\n (let ((print-level nil)\n (print-length nil))\n (apply #'format format\n (cl-loop for (i . kind) in vars collect\n (let ((thing (nth i args)))\n (cl-case kind\n (:identifier (emacsql-escape-identifier thing))\n (:scalar (emacsql-escape-scalar thing))\n (:vector (emacsql-escape-vector thing))\n (:raw (emacsql-escape-raw thing))\n (:schema (emacsql-prepare-schema thing))\n (otherwise\n (emacsql-error \"Invalid var type %S\" kind)))))))))\n\n(provide 'emacsql-compiler)\n\n;;; emacsql-compiler.el ends here\n" }, { "path": "emacsql-mysql.el", "content": ";;; emacsql-mysql.el --- EmacSQL back-end for MySQL -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Christopher Wellons \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides an EmacSQL back-end for MySQL, which uses\n;; the standard `msql' command line program.\n\n;;; Code:\n\n(require 'emacsql)\n\n(defvar emacsql-mysql-executable \"mysql\"\n \"Path to the mysql command line executable.\")\n\n(defvar emacsql-mysql-sentinel \"--------------\\n\\n--------------\\n\\n\"\n \"What MySQL will print when it has completed its output.\")\n\n(defconst emacsql-mysql-reserved\n (emacsql-register-reserved\n '( ACCESSIBLE ADD ALL ALTER ANALYZE AND AS ASC ASENSITIVE BEFORE\n BETWEEN BIGINT BINARY BLOB BOTH BY CALL CASCADE CASE CHANGE CHAR\n CHARACTER CHECK COLLATE COLUMN CONDITION CONSTRAINT CONTINUE\n CONVERT CREATE CROSS CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP\n CURRENT_USER CURSOR DATABASE DATABASES DAY_HOUR DAY_MICROSECOND\n DAY_MINUTE DAY_SECOND DEC DECIMAL DECLARE DEFAULT DELAYED DELETE\n DESC DESCRIBE DETERMINISTIC DISTINCT DISTINCTROW DIV DOUBLE DROP\n DUAL EACH ELSE ELSEIF ENCLOSED ESCAPED EXISTS EXIT EXPLAIN FALSE\n FETCH FLOAT FLOAT4 FLOAT8 FOR FORCE FOREIGN FROM FULLTEXT GENERAL\n GRANT GROUP HAVING HIGH_PRIORITY HOUR_MICROSECOND HOUR_MINUTE\n HOUR_SECOND IF IGNORE IGNORE_SERVER_IDS IN INDEX INFILE INNER\n INOUT INSENSITIVE INSERT INT INT1 INT2 INT3 INT4 INT8 INTEGER\n INTERVAL INTO IS ITERATE JOIN KEY KEYS KILL LEADING LEAVE LEFT\n LIKE LIMIT LINEAR LINES LOAD LOCALTIME LOCALTIMESTAMP LOCK LONG\n LONGBLOB LONGTEXT LOOP LOW_PRIORITY MASTER_HEARTBEAT_PERIOD\n MASTER_SSL_VERIFY_SERVER_CERT MATCH MAXVALUE MAXVALUE MEDIUMBLOB\n MEDIUMINT MEDIUMTEXT MIDDLEINT MINUTE_MICROSECOND MINUTE_SECOND\n MOD MODIFIES NATURAL NOT NO_WRITE_TO_BINLOG NULL NUMERIC ON\n OPTIMIZE OPTION OPTIONALLY OR ORDER OUT OUTER OUTFILE PRECISION\n PRIMARY PROCEDURE PURGE RANGE READ READS READ_WRITE REAL\n REFERENCES REGEXP RELEASE RENAME REPEAT REPLACE REQUIRE RESIGNAL\n RESIGNAL RESTRICT RETURN REVOKE RIGHT RLIKE SCHEMA SCHEMAS\n SECOND_MICROSECOND SELECT SENSITIVE SEPARATOR SET SHOW SIGNAL\n SIGNAL SLOW SMALLINT SPATIAL SPECIFIC SQL SQL_BIG_RESULT\n SQL_CALC_FOUND_ROWS SQLEXCEPTION SQL_SMALL_RESULT SQLSTATE\n SQLWARNING SSL STARTING STRAIGHT_JOIN TABLE TERMINATED THEN\n TINYBLOB TINYINT TINYTEXT TO TRAILING TRIGGER TRUE UNDO UNION\n UNIQUE UNLOCK UNSIGNED UPDATE USAGE USE USING UTC_DATE UTC_TIME\n UTC_TIMESTAMP VALUES VARBINARY VARCHAR VARCHARACTER VARYING WHEN\n WHERE WHILE WITH WRITE XOR YEAR_MONTH ZEROFILL))\n \"List of all of MySQL's reserved words.\nhttp://dev.mysql.com/doc/refman/5.5/en/reserved-words.html\")\n\n(defclass emacsql-mysql-connection (emacsql-connection)\n ((dbname :reader emacsql-psql-dbname :initarg :dbname)\n (types :allocation :class\n :reader emacsql-types\n :initform '((integer \"BIGINT\")\n (float \"DOUBLE\")\n (object \"LONGTEXT\")\n (nil \"LONGTEXT\"))))\n \"A connection to a MySQL database.\")\n\n(cl-defun emacsql-mysql (database &key user password host port debug)\n \"Connect to a MySQL server using the mysql command line program.\"\n (let* ((mysql (or (executable-find emacsql-mysql-executable)\n (error \"No mysql binary available, aborting\")))\n (command (list database \"--skip-pager\" \"-rfBNL\" mysql)))\n (when user (push (format \"--user=%s\" user) command))\n (when password (push (format \"--password=%s\" password) command))\n (when host (push (format \"--host=%s\" host) command))\n (when port (push (format \"--port=%s\" port) command))\n (let* ((process-connection-type t)\n (buffer (generate-new-buffer \" *emacsql-mysql*\"))\n (command (mapconcat #'shell-quote-argument (nreverse command) \" \"))\n (process (start-process-shell-command\n \"emacsql-mysql\" buffer (concat \"stty raw &&\" command)))\n (connection (make-instance 'emacsql-mysql-connection\n :handle process\n :dbname database)))\n (set-process-sentinel process\n (lambda (proc _) (kill-buffer (process-buffer proc))))\n (set-process-query-on-exit-flag (oref connection handle) nil)\n (when debug (emacsql-enable-debugging connection))\n (emacsql connection\n [:set-session (= sql-mode 'NO_BACKSLASH_ESCAPES\\,ANSI_QUOTES)])\n (emacsql connection\n [:set-transaction-isolation-level :serializable])\n (emacsql-register connection))))\n\n(cl-defmethod emacsql-close ((connection emacsql-mysql-connection))\n (let ((process (oref connection handle)))\n (when (process-live-p process)\n (process-send-eof process))))\n\n(cl-defmethod emacsql-send-message ((connection emacsql-mysql-connection) message)\n (let ((process (oref connection handle)))\n (process-send-string process message)\n (process-send-string process \"\\\\c\\\\p\\n\")))\n\n(cl-defmethod emacsql-waiting-p ((connection emacsql-mysql-connection))\n (let ((length (length emacsql-mysql-sentinel)))\n (with-current-buffer (emacsql-buffer connection)\n (and (>= (buffer-size) length)\n (progn (goto-char (- (point-max) length))\n (looking-at emacsql-mysql-sentinel))))))\n\n(cl-defmethod emacsql-parse ((connection emacsql-mysql-connection))\n (with-current-buffer (emacsql-buffer connection)\n (let ((standard-input (current-buffer)))\n (goto-char (point-min))\n (when (looking-at \"ERROR\")\n (search-forward \": \")\n (signal 'emacsql-error\n (list (buffer-substring (point) (line-end-position)))))\n (cl-loop until (looking-at emacsql-mysql-sentinel)\n collect (read) into row\n when (looking-at \"\\n\")\n collect row into rows\n and do (setq row ())\n and do (forward-char)\n finally (cl-return rows)))))\n\n(provide 'emacsql-mysql)\n\n;;; emacsql-mysql.el ends here\n" }, { "path": "emacsql-pg.el", "content": ";;; emacsql-pg.el --- EmacSQL back-end for PostgreSQL via pg -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Christopher Wellons \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides an EmacSQL back-end for PostgreSQL, which\n;; uses the `pg' package to directly speak to the database. This\n;; library requires at least Emacs 28.1.\n\n;; (For an alternative back-end for PostgreSQL, see `emacsql-psql'.)\n\n;;; Code:\n\n(require 'emacsql)\n\n(if (>= emacs-major-version 28)\n (require 'pg nil t)\n (message \"emacsql-pg.el requires Emacs 28.1 or later\"))\n(declare-function pg-connect \"ext:pg\"\n ( dbname user &optional\n (password \"\") (host \"localhost\") (port 5432) (tls nil)))\n(declare-function pg-disconnect \"ext:pg\" (con))\n(declare-function pg-exec \"ext:pg\" (connection &rest args))\n(declare-function pg-result \"ext:pg\" (result what &rest arg))\n\n(defclass emacsql-pg-connection (emacsql-connection)\n ((pgcon :reader emacsql-pg-pgcon :initarg :pgcon)\n (dbname :reader emacsql-pg-dbname :initarg :dbname)\n (result :accessor emacsql-pg-result)\n (types :allocation :class\n :reader emacsql-types\n :initform '((integer \"BIGINT\")\n (float \"DOUBLE PRECISION\")\n (object \"TEXT\")\n (nil \"TEXT\"))))\n \"A connection to a PostgreSQL database via pg.el.\")\n\n(cl-defun emacsql-pg (dbname user &key\n (host \"localhost\") (password \"\") (port 5432) debug)\n \"Connect to a PostgreSQL server using pg.el.\"\n (require 'pg)\n (let* ((pgcon (pg-connect dbname user password host port))\n (connection (make-instance 'emacsql-pg-connection\n :handle (and (fboundp 'pgcon-process)\n (pgcon-process pgcon))\n :pgcon pgcon\n :dbname dbname)))\n (when debug (emacsql-enable-debugging connection))\n (emacsql connection [:set (= default-transaction-isolation 'SERIALIZABLE)])\n (emacsql-register connection)))\n\n(cl-defmethod emacsql-close ((connection emacsql-pg-connection))\n (ignore-errors (pg-disconnect (emacsql-pg-pgcon connection))))\n\n(cl-defmethod emacsql-send-message ((connection emacsql-pg-connection) message)\n (condition-case error\n (setf (emacsql-pg-result connection)\n (pg-exec (emacsql-pg-pgcon connection) message))\n (error (signal 'emacsql-error error))))\n\n(cl-defmethod emacsql-waiting-p ((_connection emacsql-pg-connection))\n ;; pg-exec will block\n t)\n\n(cl-defmethod emacsql-parse ((connection emacsql-pg-connection))\n (let ((tuples (pg-result (emacsql-pg-result connection) :tuples)))\n (cl-loop for tuple in tuples collect\n (cl-loop for value in tuple\n when (stringp value) collect (read value)\n else collect value))))\n\n(provide 'emacsql-pg)\n\n;;; emacsql-pg.el ends here\n" }, { "path": "emacsql-psql.el", "content": ";;; emacsql-psql.el --- EmacSQL back-end for PostgreSQL via psql -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Christopher Wellons \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides an EmacSQL back-end for PostgreSQL, which\n;; uses the standard `psql' command line program.\n\n;; (For an alternative back-end for PostgreSQL, see `emacsql-pg'.)\n\n;;; Code:\n\n(require 'emacsql)\n\n(defvar emacsql-psql-executable \"psql\"\n \"Path to the psql (PostgreSQL client) executable.\")\n\n(defun emacsql-psql-unavailable-p ()\n \"Return a reason if the psql executable is not available.\n:no-executable -- cannot find the executable\n:cannot-execute -- cannot run the executable\n:old-version -- sqlite3 version is too old\"\n (let ((psql emacsql-psql-executable))\n (if (null (executable-find psql))\n :no-executable\n (condition-case _\n (with-temp-buffer\n (call-process psql nil (current-buffer) nil \"--version\")\n (let ((version (cl-third (split-string (buffer-string)))))\n (if (version< version \"1.0.0\")\n :old-version\n nil)))\n (error :cannot-execute)))))\n\n(defconst emacsql-psql-reserved\n (emacsql-register-reserved\n '( ALL ANALYSE ANALYZE AND ANY AS ASC AUTHORIZATION BETWEEN BINARY\n BOTH CASE CAST CHECK COLLATE COLUMN CONSTRAINT CREATE CROSS\n CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP CURRENT_USER DEFAULT\n DEFERRABLE DESC DISTINCT DO ELSE END EXCEPT FALSE FOR FOREIGN\n FREEZE FROM FULL GRANT GROUP HAVING ILIKE IN INITIALLY INNER\n INTERSECT INTO IS ISNULL JOIN LEADING LEFT LIKE LIMIT LOCALTIME\n LOCALTIMESTAMP NATURAL NEW NOT NOTNULL NULL OFF OFFSET OLD ON\n ONLY OR ORDER OUTER OVERLAPS PLACING PRIMARY REFERENCES RIGHT\n SELECT SESSION_USER SIMILAR SOME TABLE THEN TO TRAILING TRUE\n UNION UNIQUE USER USING VERBOSE WHEN WHERE))\n \"List of all of PostgreSQL's reserved words.\nhttp://www.postgresql.org/docs/7.3/static/sql-keywords-appendix.html\")\n\n(defclass emacsql-psql-connection (emacsql-connection)\n ((dbname :reader emacsql-psql-dbname :initarg :dbname)\n (types :allocation :class\n :reader emacsql-types\n :initform '((integer \"BIGINT\")\n (float \"DOUBLE PRECISION\")\n (object \"TEXT\")\n (nil \"TEXT\"))))\n \"A connection to a PostgreSQL database via psql.\")\n\n(cl-defun emacsql-psql (dbname &key username hostname port debug)\n \"Connect to a PostgreSQL server using the psql command line program.\"\n (let ((args (list dbname)))\n (when username\n (push username args))\n (push \"-n\" args)\n (when port\n (push \"-p\" args)\n (push port args))\n (when hostname\n (push \"-h\" args)\n (push hostname args))\n (setq args (nreverse args))\n (let* ((buffer (generate-new-buffer \" *emacsql-psql*\"))\n (psql emacsql-psql-executable)\n (command (mapconcat #'shell-quote-argument (cons psql args) \" \"))\n (process (start-process-shell-command\n \"emacsql-psql\" buffer (concat \"stty raw && \" command)))\n (connection (make-instance 'emacsql-psql-connection\n :handle process\n :dbname dbname)))\n (setf (process-sentinel process)\n (lambda (proc _) (kill-buffer (process-buffer proc))))\n (set-process-query-on-exit-flag (oref connection handle) nil)\n (when debug (emacsql-enable-debugging connection))\n (mapc (apply-partially #'emacsql-send-message connection)\n '(\"\\\\pset pager off\"\n \"\\\\pset null nil\"\n \"\\\\a\"\n \"\\\\t\"\n \"\\\\f ' '\"\n \"SET client_min_messages TO ERROR;\"\n \"\\\\set PROMPT1 ]\"\n \"EMACSQL;\")) ; error message flush\n (emacsql-wait connection)\n (emacsql connection\n [:set (= default-transaction-isolation 'SERIALIZABLE)])\n (emacsql-register connection))))\n\n(cl-defmethod emacsql-close ((connection emacsql-psql-connection))\n (let ((process (oref connection handle)))\n (when (process-live-p process)\n (process-send-string process \"\\\\q\\n\"))))\n\n(cl-defmethod emacsql-send-message ((connection emacsql-psql-connection) message)\n (let ((process (oref connection handle)))\n (process-send-string process message)\n (process-send-string process \"\\n\")))\n\n(cl-defmethod emacsql-waiting-p ((connection emacsql-psql-connection))\n (with-current-buffer (emacsql-buffer connection)\n (cond ((= (buffer-size) 1) (string= \"]\" (buffer-string)))\n ((> (buffer-size) 1) (string= \"\\n]\" (buffer-substring\n (- (point-max) 2)\n (point-max)))))))\n\n(cl-defmethod emacsql-check-error ((connection emacsql-psql-connection))\n (with-current-buffer (emacsql-buffer connection)\n (let ((case-fold-search t))\n (goto-char (point-min))\n (when (looking-at \"error:\")\n (let* ((beg (line-beginning-position))\n (end (line-end-position)))\n (signal 'emacsql-error (list (buffer-substring beg end))))))))\n\n(cl-defmethod emacsql-parse ((connection emacsql-psql-connection))\n (emacsql-check-error connection)\n (with-current-buffer (emacsql-buffer connection)\n (let ((standard-input (current-buffer)))\n (goto-char (point-min))\n (cl-loop until (looking-at \"]\")\n collect (read) into row\n when (looking-at \"\\n\")\n collect row into rows\n and do (progn (forward-char 1) (setq row ()))\n finally (cl-return rows)))))\n\n(provide 'emacsql-psql)\n\n;;; emacsql-psql.el ends here\n" }, { "path": "emacsql-sqlite-builtin.el", "content": ";;; emacsql-sqlite-builtin.el --- EmacSQL back-end for SQLite using builtin support -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Jonas Bernoulli \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides an EmacSQL back-end for SQLite, which uses\n;; the built-in SQLite support in Emacs 29 an later.\n\n;;; Code:\n\n(require 'emacsql-sqlite)\n\n(declare-function sqlite-open \"sqlite.c\")\n(declare-function sqlite-select \"sqlite.c\")\n(declare-function sqlite-close \"sqlite.c\")\n\n(emacsql-register-reserved emacsql-sqlite-reserved)\n\n(defclass emacsql-sqlite-builtin-connection (emacsql--sqlite-base) ()\n \"A connection to a SQLite database using builtin support.\")\n\n(cl-defmethod initialize-instance :after\n ((connection emacsql-sqlite-builtin-connection) &rest _)\n (oset connection handle\n (sqlite-open (oref connection file)))\n (emacsql-sqlite-set-busy-timeout connection)\n (emacsql connection [:pragma (= foreign-keys on)])\n (emacsql-register connection))\n\n(cl-defun emacsql-sqlite-builtin (file &key debug)\n \"Open a connected to database stored in FILE.\nIf FILE is nil use an in-memory database.\n\n:debug LOG -- When non-nil, log all SQLite commands to a log\nbuffer. This is for debugging purposes.\"\n (let ((connection (make-instance #'emacsql-sqlite-builtin-connection\n :file file)))\n (when debug\n (emacsql-enable-debugging connection))\n connection))\n\n(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-builtin-connection))\n (and (oref connection handle) t))\n\n(cl-defmethod emacsql-close ((connection emacsql-sqlite-builtin-connection))\n (when (oref connection handle)\n (sqlite-close (oref connection handle))\n (oset connection handle nil)))\n\n(cl-defmethod emacsql-send-message\n ((connection emacsql-sqlite-builtin-connection) message)\n (condition-case err\n (let ((headerp emacsql-include-header))\n (mapcar (lambda (row)\n (cond\n (headerp (setq headerp nil) row)\n ((mapcan (lambda (col)\n (cond ((null col) (list nil))\n ((equal col \"\") (list \"\"))\n ((numberp col) (list col))\n ((emacsql-sqlite-read-column col))))\n row))))\n (sqlite-select (oref connection handle) message nil\n (and emacsql-include-header 'full))))\n ((sqlite-error sqlite-locked-error)\n (if (stringp (cdr err))\n (signal 'emacsql-error (list (cdr err)))\n (pcase-let* ((`(,_ ,errstr ,errmsg ,errcode ,ext-errcode) err)\n (`(,_ ,_ ,signal ,_)\n (assq errcode emacsql-sqlite-error-codes)))\n (signal (or signal 'emacsql-error)\n (list errmsg errcode ext-errcode errstr)))))\n (error\n (signal 'emacsql-error (cdr err)))))\n\n(cl-defmethod emacsql ((connection emacsql-sqlite-builtin-connection) sql &rest args)\n (emacsql-send-message connection (apply #'emacsql-compile connection sql args)))\n\n(provide 'emacsql-sqlite-builtin)\n\n;;; emacsql-sqlite-builtin.el ends here\n" }, { "path": "emacsql-sqlite-module.el", "content": ";;; emacsql-sqlite-module.el --- EmacSQL back-end for SQLite using a module -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Jonas Bernoulli \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library provides an EmacSQL back-end for SQLite, which uses\n;; the Emacs module provided by the `sqlite3' package.\n\n;;; Code:\n\n(require 'emacsql-sqlite)\n\n(require 'sqlite3 nil t)\n;; Prevent check-declare from finding the defining file but then making\n;; noise because it fails to find the definition because it is a module.\n(declare-function sqlite3-open \"ext:module:sqlite3-api\")\n(declare-function sqlite3-exec \"ext:module:sqlite3-api\")\n(declare-function sqlite3-close \"ext:module:sqlite3-api\")\n(defvar sqlite-open-readwrite)\n(defvar sqlite-open-create)\n\n(emacsql-register-reserved emacsql-sqlite-reserved)\n\n(defclass emacsql-sqlite-module-connection (emacsql--sqlite-base) ()\n \"A connection to a SQLite database using a module.\")\n\n(cl-defmethod initialize-instance :after\n ((connection emacsql-sqlite-module-connection) &rest _)\n (require (quote sqlite3))\n (oset connection handle\n (sqlite3-open (or (oref connection file) \":memory:\")\n sqlite-open-readwrite\n sqlite-open-create))\n (emacsql-sqlite-set-busy-timeout connection)\n (emacsql connection [:pragma (= foreign-keys on)])\n (emacsql-register connection))\n\n(cl-defun emacsql-sqlite-module (file &key debug)\n \"Open a connected to database stored in FILE.\nIf FILE is nil use an in-memory database.\n\n:debug LOG -- When non-nil, log all SQLite commands to a log\nbuffer. This is for debugging purposes.\"\n (let ((connection (make-instance #'emacsql-sqlite-module-connection\n :file file)))\n (when debug\n (emacsql-enable-debugging connection))\n connection))\n\n(cl-defmethod emacsql-live-p ((connection emacsql-sqlite-module-connection))\n (and (oref connection handle) t))\n\n(cl-defmethod emacsql-close ((connection emacsql-sqlite-module-connection))\n (when (oref connection handle)\n (sqlite3-close (oref connection handle))\n (oset connection handle nil)))\n\n(cl-defmethod emacsql-send-message\n ((connection emacsql-sqlite-module-connection) message)\n (condition-case err\n (let ((include-header emacsql-include-header)\n (rows ()))\n (sqlite3-exec (oref connection handle)\n message\n (lambda (_ row header)\n (when include-header\n (push header rows)\n (setq include-header nil))\n (push (mapcan (lambda (col)\n (cond\n ((null col) (list nil))\n ((equal col \"\") (list \"\"))\n ((emacsql-sqlite-read-column col))))\n row)\n rows)))\n (nreverse rows))\n ((db-error sql-error)\n (pcase-let* ((`(,_ ,errmsg ,errcode) err)\n (`(,_ ,_ ,signal ,errstr)\n (assq errcode emacsql-sqlite-error-codes)))\n (signal (or signal 'emacsql-error)\n (list errmsg errcode nil errstr))))\n (error\n (signal 'emacsql-error (cdr err)))))\n\n(cl-defmethod emacsql ((connection emacsql-sqlite-module-connection) sql &rest args)\n (emacsql-send-message connection (apply #'emacsql-compile connection sql args)))\n\n(provide 'emacsql-sqlite-module)\n\n;;; emacsql-sqlite-module.el ends here\n" }, { "path": "emacsql-sqlite.el", "content": ";;; emacsql-sqlite.el --- Code used by both SQLite back-ends -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Jonas Bernoulli \n;; Maintainer: Jonas Bernoulli \n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; This library contains code that is used by both SQLite back-ends.\n\n;;; Code:\n\n(require 'emacsql)\n\n;;; Base class\n\n(defclass emacsql--sqlite-base (emacsql-connection)\n ((file :initarg :file\n :initform nil\n :type (or null string)\n :documentation \"Database file name.\")\n (types :allocation :class\n :reader emacsql-types\n :initform '((integer \"INTEGER\")\n (float \"REAL\")\n (object \"TEXT\")\n (nil nil))))\n :abstract t)\n\n;;; Constants\n\n(defconst emacsql-sqlite-reserved\n '( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH\n AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK\n COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS\n CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT\n DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END\n ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL\n GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY\n INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE\n LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER\n OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP\n REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW\n SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION\n TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN\n WHERE WITH WITHOUT)\n \"List of all of SQLite's reserved words.\nAlso see http://www.sqlite.org/lang_keywords.html.\")\n\n(defconst emacsql-sqlite-error-codes\n '((1 SQLITE_ERROR emacsql-error \"SQL logic error\")\n (2 SQLITE_INTERNAL emacsql-internal nil)\n (3 SQLITE_PERM emacsql-access \"access permission denied\")\n (4 SQLITE_ABORT emacsql-error \"query aborted\")\n (5 SQLITE_BUSY emacsql-locked \"database is locked\")\n (6 SQLITE_LOCKED emacsql-locked \"database table is locked\")\n (7 SQLITE_NOMEM emacsql-memory \"out of memory\")\n (8 SQLITE_READONLY emacsql-access \"attempt to write a readonly database\")\n (9 SQLITE_INTERRUPT emacsql-error \"interrupted\")\n (10 SQLITE_IOERR emacsql-access \"disk I/O error\")\n (11 SQLITE_CORRUPT emacsql-corruption \"database disk image is malformed\")\n (12 SQLITE_NOTFOUND emacsql-error \"unknown operation\")\n (13 SQLITE_FULL emacsql-access \"database or disk is full\")\n (14 SQLITE_CANTOPEN emacsql-access \"unable to open database file\")\n (15 SQLITE_PROTOCOL emacsql-access \"locking protocol\")\n (16 SQLITE_EMPTY emacsql-corruption nil)\n (17 SQLITE_SCHEMA emacsql-error \"database schema has changed\")\n (18 SQLITE_TOOBIG emacsql-error \"string or blob too big\")\n (19 SQLITE_CONSTRAINT emacsql-constraint \"constraint failed\")\n (20 SQLITE_MISMATCH emacsql-error \"datatype mismatch\")\n (21 SQLITE_MISUSE emacsql-error \"bad parameter or other API misuse\")\n (22 SQLITE_NOLFS emacsql-error \"large file support is disabled\")\n (23 SQLITE_AUTH emacsql-access \"authorization denied\")\n (24 SQLITE_FORMAT emacsql-corruption nil)\n (25 SQLITE_RANGE emacsql-error \"column index out of range\")\n (26 SQLITE_NOTADB emacsql-corruption \"file is not a database\")\n (27 SQLITE_NOTICE emacsql-warning \"notification message\")\n (28 SQLITE_WARNING emacsql-warning \"warning message\"))\n \"Alist mapping SQLite error codes to EmacSQL conditions.\nElements have the form (ERRCODE SYMBOLIC-NAME EMACSQL-ERROR\nERRSTR). Also see https://www.sqlite.org/rescode.html.\")\n\n;;; Variables\n\n(defvar emacsql-include-header nil\n \"Whether to include names of columns as an additional row.\nNever enable this globally, only let-bind it around calls to `emacsql'.\nCurrently only supported by `emacsql-sqlite-builtin-connection' and\n`emacsql-sqlite-module-connection'.\")\n\n(defvar emacsql-sqlite-busy-timeout 20\n \"Seconds to wait when trying to access a table blocked by another process.\nSee https://www.sqlite.org/c3ref/busy_timeout.html.\")\n\n;;; Utilities\n\n(defun emacsql-sqlite-connection (variable file &optional setup use-module)\n \"Return the connection stored in VARIABLE to the database in FILE.\n\nIf the value of VARIABLE is a live database connection, return that.\n\nOtherwise open a new connection to the database in FILE and store the\nconnection in VARIABLE, before returning it. If FILE is nil, use an\nin-memory database. Always enable support for foreign key constrains.\nIf optional SETUP is non-nil, it must be a function, which takes the\nconnection as only argument. This function can be used to initialize\ntables, for example.\n\nIf optional USE-MODULE is non-nil, then use the external module even\nwhen Emacs was built with SQLite support. This is intended for testing\npurposes.\"\n (or (let ((connection (symbol-value variable)))\n (and connection (emacsql-live-p connection) connection))\n (set variable (emacsql-sqlite-open file nil setup use-module))))\n\n(defun emacsql-sqlite-open (file &optional debug setup use-module)\n \"Open a connection to the database stored in FILE using an SQLite back-end.\n\nAutomatically use the best available back-end, as returned by\n`emacsql-sqlite-default-connection'.\n\nIf FILE is nil, use an in-memory database. If optional DEBUG is\nnon-nil, log all SQLite commands to a log buffer, for debugging\npurposes. Always enable support for foreign key constrains.\n\nIf optional SETUP is non-nil, it must be a function, which takes the\nconnection as only argument. This function can be used to initialize\ntables, for example.\n\nIf optional USE-MODULE is non-nil, then use the external module even\nwhen Emacs was built with SQLite support. This is intended for testing\npurposes.\"\n (when file\n (make-directory (file-name-directory file) t))\n (let* ((class (emacsql-sqlite-default-connection use-module))\n (connection (make-instance class :file file)))\n (when debug\n (emacsql-enable-debugging connection))\n (emacsql connection [:pragma (= foreign-keys on)])\n (when setup\n (funcall setup connection))\n connection))\n\n(defun emacsql-sqlite-default-connection (&optional use-module)\n \"Determine and return the best SQLite connection class.\n\nSignal an error if none of the connection classes can be used.\n\nIf optional USE-MODULE is non-nil, then use the external module even\nwhen Emacs was built with SQLite support. This is intended for testing\npurposes.\"\n (or (and (not use-module)\n (fboundp 'sqlite-available-p)\n (sqlite-available-p)\n (require 'emacsql-sqlite-builtin)\n 'emacsql-sqlite-builtin-connection)\n (and (boundp 'module-file-suffix)\n module-file-suffix\n (condition-case nil\n ;; Failure modes:\n ;; 1. `libsqlite' shared library isn't available.\n ;; 2. User chooses to not compile `libsqlite'.\n ;; 3. `libsqlite' compilation fails.\n (and (require 'sqlite3)\n (require 'emacsql-sqlite-module)\n 'emacsql-sqlite-module-connection)\n (error\n (display-warning 'emacsql \"\\\nSince your Emacs does not come with\nbuilt-in SQLite support [1], but does support C modules, we can\nuse an EmacSQL backend that relies on the third-party `sqlite3'\npackage [2].\n\nPlease install the `sqlite3' Elisp package using your preferred\nEmacs package manager, and install the SQLite shared library\nusing your distribution's package manager. That package should\nbe named something like `libsqlite3' [3] and NOT just `sqlite3'.\n\nThe legacy backend, which uses a custom SQLite executable, has\nbeen remove, so we can no longer fall back to that.\n\n[1]: Supported since Emacs 29.1, provided it was not disabled\n with `--without-sqlite3'.\n[2]: https://github.com/pekingduck/emacs-sqlite3-api\n[3]: On Debian https://packages.debian.org/buster/libsqlite3-0\")\n ;; The buffer displaying the warning might immediately\n ;; be replaced by another buffer, before the user gets\n ;; a chance to see it. We cannot have that.\n (let (fn)\n (setq fn (lambda ()\n (remove-hook 'post-command-hook fn)\n (pop-to-buffer (get-buffer \"*Warnings*\"))))\n (add-hook 'post-command-hook fn))\n nil)))\n (error \"EmacSQL could not find or compile a back-end\")))\n\n(defun emacsql-sqlite-set-busy-timeout (connection)\n (when emacsql-sqlite-busy-timeout\n (emacsql connection [:pragma (= busy-timeout $s1)]\n (* emacsql-sqlite-busy-timeout 1000))))\n\n(defun emacsql-sqlite-read-column (string)\n (let ((value nil)\n (beg 0)\n (end (length string)))\n (while (< beg end)\n (let ((v (read-from-string string beg)))\n (push (car v) value)\n (setq beg (cdr v))))\n (nreverse value)))\n\n(defun emacsql-sqlite-list-tables (connection)\n \"Return a list of symbols identifying tables in CONNECTION.\nTables whose names begin with \\\"sqlite_\\\", are not included\nin the returned value.\"\n (mapcar #'car\n (emacsql connection\n [:select name\n ;; The new name is `sqlite-schema', but this name\n ;; is supported by old and new SQLite versions.\n ;; See https://www.sqlite.org/schematab.html.\n :from sqlite-master\n :where (and (= type 'table)\n (not-like name \"sqlite_%\"))\n :order-by [(asc name)]])))\n\n(defun emacsql-sqlite-dump-database (connection &optional versionp)\n \"Dump the database specified by CONNECTION to a file.\n\nThe dump file is placed in the same directory as the database\nfile and its name derives from the name of the database file.\nThe suffix is replaced with \\\".sql\\\" and if optional VERSIONP is\nnon-nil, then the database version (the `user_version' pragma)\nand a timestamp are appended to the file name.\n\nDumping is done using the official `sqlite3' binary. If that is\nnot available and VERSIONP is non-nil, then the database file is\ncopied instead.\"\n (let* ((version (caar (emacsql connection [:pragma user-version])))\n (db (oref connection file))\n (db (if (symbolp db) (symbol-value db) db))\n (name (file-name-nondirectory db))\n (output (concat (file-name-sans-extension db)\n (and versionp\n (concat (format \"-v%s\" version)\n (format-time-string \"-%Y%m%d-%H%M\")))\n \".sql\")))\n (cond\n ((locate-file \"sqlite3\" exec-path)\n (when (and (file-exists-p output) versionp)\n (error \"Cannot dump database; %s already exists\" output))\n (with-temp-file output\n (message \"Dumping %s database to %s...\" name output)\n (unless (zerop (save-excursion\n (call-process \"sqlite3\" nil t nil db \".dump\")))\n (error \"Failed to dump %s\" db))\n (when version\n (insert (format \"PRAGMA user_version=%s;\\n\" version)))\n ;; The output contains \"PRAGMA foreign_keys=OFF;\".\n ;; Change that to avoid alarming attentive users.\n (when (re-search-forward \"^PRAGMA foreign_keys=\\\\(OFF\\\\);\" 1000 t)\n (replace-match \"ON\" t t nil 1))\n (message \"Dumping %s database to %s...done\" name output)))\n (versionp\n (setq output (concat (file-name-sans-extension output) \".db\"))\n (message \"Cannot dump database because sqlite3 binary cannot be found\")\n (when (and (file-exists-p output) versionp)\n (error \"Cannot copy database; %s already exists\" output))\n (message \"Copying %s database to %s...\" name output)\n (copy-file db output)\n (message \"Copying %s database to %s...done\" name output))\n ((error \"Cannot dump database; sqlite3 binary isn't available\")))))\n\n(defun emacsql-sqlite-restore-database (db dump)\n \"Restore database DB from DUMP.\n\nDUMP is a file containing SQL statements. DB can be the file\nin which the database is to be stored, or it can be a database\nconnection. In the latter case the current database is first\ndumped to a new file and the connection is closed. Then the\ndatabase is restored from DUMP. No connection to the new\ndatabase is created.\"\n (unless (stringp db)\n (emacsql-sqlite-dump-database db t)\n (emacsql-close (prog1 db (setq db (oref db file)))))\n (with-temp-buffer\n (unless (zerop (call-process \"sqlite3\" nil t nil db\n (format \".read %s\" dump)))\n (error \"Failed to read %s: %s\" dump (buffer-string)))))\n\n(provide 'emacsql-sqlite)\n\n;;; emacsql-sqlite.el ends here\n" }, { "path": "emacsql.el", "content": ";;; emacsql.el --- High-level SQL database front-end -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;; Author: Christopher Wellons \n;; Maintainer: Jonas Bernoulli \n;; Homepage: https://github.com/magit/emacsql\n\n;; Package-Version: 4.3.6\n;; Package-Requires: ((emacs \"26.1\"))\n\n;; SPDX-License-Identifier: Unlicense\n\n;;; Commentary:\n\n;; EmacSQL is a high-level Emacs Lisp front-end for SQLite.\n\n;; PostgreSQL and MySQL are also supported, but use of these connectors\n;; is not recommended.\n\n;; Any readable lisp value can be stored as a value in EmacSQL,\n;; including numbers, strings, symbols, lists, vectors, and closures.\n;; EmacSQL has no concept of TEXT values; it's all just lisp objects.\n;; The lisp object `nil' corresponds 1:1 with NULL in the database.\n\n;; See README.md for much more complete documentation.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'cl-generic)\n(require 'eieio)\n\n(require 'emacsql-compiler)\n\n(defgroup emacsql nil\n \"The EmacSQL SQL database front-end.\"\n :group 'comm)\n\n(defconst emacsql-version \"4.3.6\")\n\n(defvar emacsql-global-timeout 30\n \"Maximum number of seconds to wait before bailing out on a SQL command.\nIf nil, wait forever. This is used by the `mysql', `pg' and `psql'. It\nis not being used by the `sqlite-builtin' and `sqlite-module' back-ends,\nwhich respect `emacsql-sqlite-busy-timeout' instead.\")\n\n;;; Database connection\n\n(defclass emacsql-connection ()\n ((handle :initarg :handle\n :documentation \"Internal connection handler.\nThe value is a record-like object and should not be accessed\ndirectly. Depending on the concrete implementation, `type-of'\nmay return `process', `user-ptr' or `sqlite' for this value.\")\n (log-buffer :type (or null buffer)\n :initarg :log-buffer\n :initform nil\n :documentation \"Output log (debug).\")\n (finalizer :documentation \"Object returned from `make-finalizer'.\")\n (types :allocation :class\n :initform nil\n :reader emacsql-types\n :documentation \"Maps EmacSQL types to SQL types.\"))\n \"A connection to a SQL database.\"\n :abstract t)\n\n(cl-defgeneric emacsql-close (connection)\n \"Close CONNECTION and free all resources.\")\n\n(cl-defgeneric emacsql-reconnect (connection)\n \"Re-establish CONNECTION with the same parameters.\")\n\n(cl-defmethod emacsql-live-p ((connection emacsql-connection))\n \"Return non-nil if CONNECTION is still alive and ready.\"\n (and (process-live-p (oref connection handle)) t))\n\n(cl-defgeneric emacsql-types (connection)\n \"Return an alist mapping EmacSQL types to database types.\nThis will mask `emacsql-type-map' during expression compilation.\nThis alist should have four key symbols: integer, float, object,\nnil (default type). The values are strings to be inserted into\na SQL expression.\")\n\n(cl-defmethod emacsql-buffer ((connection emacsql-connection))\n \"Get process buffer for CONNECTION.\"\n (process-buffer (oref connection handle)))\n\n(cl-defmethod emacsql-enable-debugging ((connection emacsql-connection))\n \"Enable debugging on CONNECTION.\"\n (unless (buffer-live-p (oref connection log-buffer))\n (oset connection log-buffer (generate-new-buffer \" *emacsql-log*\"))))\n\n(cl-defmethod emacsql-log ((connection emacsql-connection) message)\n \"Log MESSAGE into CONNECTION's log.\nMESSAGE should not have a newline on the end.\"\n (let ((buffer (oref connection log-buffer)))\n (when buffer\n (unless (buffer-live-p buffer)\n (setq buffer (emacsql-enable-debugging connection)))\n (with-current-buffer buffer\n (goto-char (point-max))\n (princ (concat message \"\\n\") buffer)))))\n\n;;; Sending and receiving\n\n(cl-defgeneric emacsql-send-message (connection message)\n \"Send MESSAGE to CONNECTION.\")\n\n(cl-defmethod emacsql-send-message :before\n ((connection emacsql-connection) message)\n (emacsql-log connection message))\n\n(cl-defmethod emacsql-clear ((connection emacsql-connection))\n \"Clear the connection buffer for CONNECTION-SPEC.\"\n (let ((buffer (emacsql-buffer connection)))\n (when (and buffer (buffer-live-p buffer))\n (with-current-buffer buffer\n (erase-buffer)))))\n\n(cl-defgeneric emacsql-waiting-p (connection)\n \"Return non-nil if CONNECTION is ready for more input.\")\n\n(cl-defmethod emacsql-wait ((connection emacsql-connection) &optional timeout)\n \"Block until CONNECTION is waiting for further input.\"\n (let* ((real-timeout (or timeout emacsql-global-timeout))\n (end (and real-timeout (+ (float-time) real-timeout))))\n (while (and (or (null real-timeout) (< (float-time) end))\n (not (emacsql-waiting-p connection)))\n (save-match-data\n (accept-process-output (oref connection handle) real-timeout)))\n (unless (emacsql-waiting-p connection)\n (signal 'emacsql-timeout (list \"Query timed out\" real-timeout)))))\n\n(cl-defgeneric emacsql-parse (connection)\n \"Return the results of parsing the latest output or signal an error.\")\n\n(defun emacsql-compile (connection sql &rest args)\n \"Compile s-expression SQL for CONNECTION into a string.\"\n (let ((emacsql-type-map (or (and connection (emacsql-types connection))\n emacsql-type-map)))\n (concat (apply #'emacsql-format (emacsql-prepare sql) args) \";\")))\n\n(cl-defgeneric emacsql (connection sql &rest args)\n \"Send SQL s-expression to CONNECTION and return the results.\")\n\n(cl-defmethod emacsql ((connection emacsql-connection) sql &rest args)\n (let ((sql-string (apply #'emacsql-compile connection sql args)))\n (emacsql-clear connection)\n (emacsql-send-message connection sql-string)\n (emacsql-wait connection)\n (emacsql-parse connection)))\n\n;;; Helper mixin class\n\n(defclass emacsql-protocol-mixin () ()\n \"A mixin for back-ends following the EmacSQL protocol.\nThe back-end prompt must be a single \\\"]\\\" character. This prompt\nvalue was chosen because it is unreadable. Output must have\nexactly one row per line, fields separated by whitespace. NULL\nmust display as \\\"nil\\\".\"\n :abstract t)\n\n(cl-defmethod emacsql-waiting-p ((connection emacsql-protocol-mixin))\n \"Return t if the end of the buffer has a properly-formatted prompt.\nAlso return t if the connection buffer has been killed.\"\n (let ((buffer (emacsql-buffer connection)))\n (or (not (buffer-live-p buffer))\n (with-current-buffer buffer\n (and (>= (buffer-size) 2)\n (string= \"#\\n\"\n (buffer-substring (- (point-max) 2) (point-max))))))))\n\n(cl-defmethod emacsql-handle ((_ emacsql-protocol-mixin) code message)\n \"Signal a specific condition for CODE from CONNECTION.\nSubclasses should override this method in order to provide more\nspecific error conditions.\"\n (signal 'emacsql-error (list message code)))\n\n(cl-defmethod emacsql-parse ((connection emacsql-protocol-mixin))\n \"Parse well-formed output into an s-expression.\"\n (with-current-buffer (emacsql-buffer connection)\n (goto-char (point-min))\n (let* ((standard-input (current-buffer))\n (value (read)))\n (if (eq value 'error)\n (emacsql-handle connection (read) (read))\n (prog1 value\n (unless (eq (read) 'success)\n (emacsql-handle connection (read) (read))))))))\n\n;;; Automatic connection cleanup\n\n(defun emacsql-register (connection)\n \"Register CONNECTION for automatic cleanup and return CONNECTION.\"\n (prog1 connection\n (oset connection finalizer\n (make-finalizer (lambda () (emacsql-close connection))))))\n\n;;; Useful macros\n\n(defmacro emacsql-with-connection (connection-spec &rest body)\n \"Open an EmacSQL connection, evaluate BODY, and close the connection.\nCONNECTION-SPEC establishes a single binding.\n\n (emacsql-with-connection (db (emacsql-sqlite \\\"company.db\\\"))\n (emacsql db [:create-table foo [x]])\n (emacsql db [:insert :into foo :values ([1] [2] [3])])\n (emacsql db [:select * :from foo]))\"\n (declare (indent 1))\n `(let ((,(car connection-spec) ,(cadr connection-spec)))\n (unwind-protect\n (progn ,@body)\n (emacsql-close ,(car connection-spec)))))\n\n(defvar emacsql--transaction-level 0\n \"Keeps track of nested transactions in `emacsql-with-transaction'.\")\n\n(defmacro emacsql-with-transaction (connection &rest body)\n \"Evaluate BODY inside a single transaction, issuing a rollback on error.\nThis macro can be nested indefinitely, wrapping everything in a\nsingle transaction at the lowest level.\n\nWarning: BODY should *not* have any side effects besides making\nchanges to the database behind CONNECTION. Body may be evaluated\nmultiple times before the changes are committed.\"\n (declare (indent 1))\n `(let ((emacsql--connection ,connection)\n (emacsql--completed nil)\n (emacsql--transaction-level (1+ emacsql--transaction-level))\n (emacsql--result))\n (unwind-protect\n (while (not emacsql--completed)\n (condition-case nil\n (progn\n (when (= 1 emacsql--transaction-level)\n (emacsql emacsql--connection [:begin]))\n (let ((result (progn ,@body)))\n (setq emacsql--result result)\n (when (= 1 emacsql--transaction-level)\n (emacsql emacsql--connection [:commit]))\n (setq emacsql--completed t)))\n (emacsql-locked (emacsql emacsql--connection [:rollback])\n (sleep-for 0.05))))\n (when (and (= 1 emacsql--transaction-level)\n (not emacsql--completed))\n (emacsql emacsql--connection [:rollback])))\n emacsql--result))\n\n(defmacro emacsql-thread (connection &rest statements)\n \"Thread CONNECTION through STATEMENTS.\nA statement can be a list, containing a statement with its arguments.\"\n (declare (indent 1))\n `(let ((emacsql--conn ,connection))\n (emacsql-with-transaction emacsql--conn\n ,@(cl-loop for statement in statements\n when (vectorp statement)\n collect (list 'emacsql 'emacsql--conn statement)\n else\n collect (append (list 'emacsql 'emacsql--conn) statement)))))\n\n(defmacro emacsql-with-bind (connection sql-and-args &rest body)\n \"For each result row bind the column names for each returned row.\nReturns the result of the last evaluated BODY.\n\nAll column names must be provided in the query ($ and * are not\nallowed). Hint: all of the bound identifiers must be known at\ncompile time. For example, in the expression below the variables\n`name' and `phone' will be bound for the body.\n\n (emacsql-with-bind db [:select [name phone] :from people]\n (message \\\"Found %s with %s\\\" name phone))\n\n (emacsql-with-bind db ([:select [name phone]\n :from people\n :where (= name $1)] my-name)\n (message \\\"Found %s with %s\\\" name phone))\n\nEach column must be a plain symbol, no expressions allowed here.\"\n (declare (indent 2))\n (let ((sql (if (vectorp sql-and-args) sql-and-args (car sql-and-args)))\n (args (and (not (vectorp sql-and-args)) (cdr sql-and-args))))\n (cl-assert (eq :select (elt sql 0)))\n (let ((vars (elt sql 1)))\n (when (eq vars '*)\n (error \"Must explicitly list columns in `emacsql-with-bind'\"))\n (cl-assert (cl-every #'symbolp vars))\n `(let ((emacsql--results (emacsql ,connection ,sql ,@args))\n (emacsql--final nil))\n (dolist (emacsql--result emacsql--results emacsql--final)\n (setq emacsql--final\n (cl-destructuring-bind ,(cl-coerce vars 'list) emacsql--result\n ,@body)))))))\n\n;;; User interaction functions\n\n(defvar emacsql-show-buffer-name \"*emacsql-show*\"\n \"Name of the buffer for displaying intermediate SQL.\")\n\n(defun emacsql--indent ()\n \"Indent and wrap the SQL expression in the current buffer.\"\n (save-excursion\n (goto-char (point-min))\n (let ((case-fold-search nil))\n (while (search-forward-regexp \" [A-Z]+\" nil :no-error)\n (when (> (current-column) (* fill-column 0.8))\n (backward-word)\n (insert \"\\n \"))))))\n\n(defun emacsql-show-sql (string)\n \"Fontify and display the SQL expression in STRING.\"\n (let ((fontified\n (with-temp-buffer\n (insert string)\n (sql-mode)\n (with-no-warnings ;; autoloaded by previous line\n (sql-highlight-sqlite-keywords))\n (font-lock-ensure)\n (emacsql--indent)\n (buffer-string))))\n (with-current-buffer (get-buffer-create emacsql-show-buffer-name)\n (if (< (length string) fill-column)\n (message \"%s\" fontified)\n (let ((buffer-read-only nil))\n (erase-buffer)\n (insert fontified))\n (special-mode)\n (visual-line-mode)\n (pop-to-buffer (current-buffer))))))\n\n(defun emacsql-flatten-sql (sql)\n \"Convert a s-expression SQL into a flat string for display.\"\n (cl-destructuring-bind (string . vars) (emacsql-prepare sql)\n (concat\n (apply #'format string (cl-loop for i in (mapcar #'car vars)\n collect (intern (format \"$%d\" (1+ i)))))\n \";\")))\n\n;;;###autoload\n(defun emacsql-show-last-sql (&optional prefix)\n \"Display the compiled SQL of the s-expression SQL expression before point.\nA prefix argument causes the SQL to be printed into the current buffer.\"\n (interactive \"P\")\n (let ((sexp (if (fboundp 'elisp--preceding-sexp)\n (elisp--preceding-sexp)\n (with-no-warnings\n (preceding-sexp)))))\n (if (emacsql-sql-p sexp)\n (let ((sql (emacsql-flatten-sql sexp)))\n (if prefix\n (insert sql)\n (emacsql-show-sql sql)))\n (user-error \"Invalid SQL: %S\" sexp))))\n\n;;; Fix Emacs' broken vector indentation\n\n(defun emacsql--inside-vector-p ()\n \"Return non-nil if point is inside a vector expression.\"\n (let ((start (point)))\n (save-excursion\n (beginning-of-defun)\n (let ((containing-sexp (elt (parse-partial-sexp (point) start) 1)))\n (and containing-sexp\n (progn (goto-char containing-sexp)\n (looking-at \"\\\\[\")))))))\n\n(defun emacsql--calculate-vector-indent (fn &optional parse-start)\n \"Don't indent vectors in `emacs-lisp-mode' like lists.\"\n (if (save-excursion (beginning-of-line) (emacsql--inside-vector-p))\n (let ((lisp-indent-offset 1))\n (funcall fn parse-start))\n (funcall fn parse-start)))\n\n(defun emacsql-fix-vector-indentation ()\n \"When called, advise `calculate-lisp-indent' to stop indenting vectors.\nOnce activated, vector contents no longer indent like lists.\"\n (interactive)\n (advice-add 'calculate-lisp-indent :around\n #'emacsql--calculate-vector-indent))\n\n(provide 'emacsql)\n\n;;; emacsql.el ends here\n" }, { "path": "test/.nosearch", "content": "" }, { "path": "test/Makefile", "content": "-include ../config.mk\ninclude ../default.mk\n\nLOAD_PATH += -L ../\n\nTEST_ELS = emacsql-compiler-tests.el\nTEST_ELS += emacsql-external-tests.el\nTEST_ELCS = $(TEST_ELS:.el=.elc)\n\ntest: lisp\n\t@printf \"Running compiler tests...\\n\"\n\t@$(EMACS_BATCH) -l emacsql-compiler-tests.elc -f ert-run-tests-batch-and-exit\n\t@printf \"Running connector tests...\\n\"\n\t@$(EMACS_BATCH) -l emacsql-external-tests.elc -f ert-run-tests-batch-and-exit\n\ntest-interactive:\n\t@$(EMACS_INTR) $(addprefix -l ,$(TEST_ELS)) --eval \"(ert t)\"\n\nlisp: $(addprefix ../,$(ELCS)) $(TEST_ELCS)\n\n%.elc: %.el\n\t@printf \"Compiling $<\\n\"\n\t@$(EMACS_BATCH) --funcall batch-byte-compile $<\n\nclean:\n\t@printf \" Cleaning test/*...\\n\"\n\t@rm -rf $(TEST_ELCS)\n" }, { "path": "test/emacsql-compiler-tests.el", "content": ";;; emacsql-tests.el --- Tests for emacsql -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;;; Code:\n\n(require 'ert)\n(require 'emacsql)\n\n(ert-deftest emacsql-escape-identifier ()\n (should-error (emacsql-escape-identifier \"foo\"))\n (should (string= (emacsql-escape-identifier 'foo) \"foo\"))\n (should (string= (emacsql-escape-identifier 'a\\ b) \"\\\"a\\\\ b\\\"\"))\n (should (string= (emacsql-escape-identifier '$foo) \"\\\"$foo\\\"\"))\n (emacsql-register-reserved '(SELECT))\n (should (string= (emacsql-escape-identifier 'select) \"\\\"select\\\"\"))\n (should-error (emacsql-escape-identifier 10))\n (should-error (emacsql-escape-identifier nil))\n (should (string= (emacsql-escape-identifier 'person-id) \"person_id\"))\n (should (string= (emacsql-escape-identifier 'people:person-id)\n \"people.person_id\"))\n (should (string= (emacsql-escape-identifier 'foo$) \"foo$\"))\n (should (string= (emacsql-escape-identifier 'foo:bar) \"foo.bar\")))\n\n(ert-deftest emacsql-escape-scalar ()\n (should (string= (emacsql-escape-scalar 'foo) \"'foo'\"))\n (should (string= (emacsql-escape-scalar \"foo\") \"'\\\"foo\\\"'\"))\n (should (string= (emacsql-escape-scalar :foo) \"':foo'\"))\n (should (string= (emacsql-escape-scalar [1 2 3]) \"'[1 2 3]'\"))\n (should (string= (emacsql-escape-scalar '(a b c)) \"'(a b c)'\"))\n (should (string= (emacsql-escape-scalar nil) \"NULL\")))\n\n(ert-deftest emacsql-escape-vector ()\n (should (string= (emacsql-escape-vector [1 2 3]) \"(1, 2, 3)\"))\n (should (string= (emacsql-escape-vector '([1 2 3])) \"(1, 2, 3)\"))\n (should (string= (emacsql-escape-vector '([1 2 3] [4 5 6]))\n \"(1, 2, 3), (4, 5, 6)\")))\n\n(ert-deftest emacsql-escape-raw ()\n (should (string= (emacsql-escape-raw \"/var/emacsql\") \"'/var/emacsql'\"))\n (should (string= (emacsql-escape-raw \"a b c\") \"'a b c'\"))\n (should (string= (emacsql-escape-raw \"a 'b' c\") \"'a ''b'' c'\"))\n (should (string= (emacsql-escape-raw nil) \"NULL\")))\n\n(ert-deftest emacsql-schema ()\n (should (string= (emacsql-prepare-schema [a]) \"a &NONE\"))\n (should (string= (emacsql-prepare-schema [a b c])\n \"a &NONE, b &NONE, c &NONE\"))\n (should (string= (emacsql-prepare-schema [a (b)])\n \"a &NONE, b &NONE\"))\n (should (string= (emacsql-prepare-schema [a (b float)])\n \"a &NONE, b &REAL\"))\n (should (string= (emacsql-prepare-schema\n [a (b float :primary-key :unique)])\n \"a &NONE, b &REAL PRIMARY KEY UNIQUE\"))\n (should (string= (emacsql-prepare-schema [(a integer) (b float)])\n \"a &INTEGER, b &REAL\")))\n\n(ert-deftest emacsql-param ()\n (should (equal (emacsql-param 'a) nil))\n (should (equal (emacsql-param 0) nil))\n (should (equal (emacsql-param \"\") nil))\n (should (equal (emacsql-param '$) nil))\n (should (equal (emacsql-param '$1) nil))\n (should (equal (emacsql-param '$s5) '(4 . :scalar)))\n (should (equal (emacsql-param '$v10) '(9 . :vector)))\n (should (equal (emacsql-param '$r2) '(1 . :raw)))\n (should (equal (emacsql-param '$a) nil))\n (should (equal (emacsql-param '$i10) '(9 . :identifier))))\n\n(defun emacsql-tests-query (query args result)\n \"Check that QUERY outputs RESULT for ARGS.\"\n (should (string= (apply #'emacsql-compile nil query args)\n result)))\n\n(defmacro emacsql-tests-with-queries (&rest queries)\n \"Thread `emacsql-tests-query' through QUERIES.\"\n (declare (indent 0))\n (cons 'progn (mapcar (lambda (q) (cons 'emacsql-tests-query q)) queries)))\n\n(ert-deftest emacsql-select ()\n (emacsql-tests-with-queries\n ([:select [$i1 name] :from $i2] '(id people)\n \"SELECT id, name FROM people;\")\n ([:select * :from employees] '()\n \"SELECT * FROM employees;\")\n ([:select * :from employees :where (< salary 50000)] '()\n \"SELECT * FROM employees WHERE salary < 50000;\")\n ([:select * :from people :where (in name $v1)] '([FOO BAR])\n \"SELECT * FROM people WHERE name IN ('FOO', 'BAR');\")\n ;; Sub queries\n ([:select name :from [:select * :from $i1]] '(people)\n \"SELECT name FROM (SELECT * FROM people);\")\n ([:select name :from [people (as accounts a)]] '()\n \"SELECT name FROM people, accounts AS a;\")\n ([:select p:name :from [(as [:select * :from people] p)]] '()\n \"SELECT p.name FROM (SELECT * FROM people) AS p;\")))\n\n(ert-deftest emacsql-attach ()\n (emacsql-tests-with-queries\n ([:attach $r1 :as $i2] '(\"/var/foo.db\" foo)\n \"ATTACH '/var/foo.db' AS foo;\")\n ([:detach $i1] '(foo)\n \"DETACH foo;\")))\n\n(ert-deftest emacsql-create-table ()\n (emacsql-tests-with-queries\n ([:create-table foo ([a b c])] ()\n \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE);\")\n ([:create-temporary-table :if-not-exists x ([y])] '()\n \"CREATE TEMPORARY TABLE IF NOT EXISTS x (y &NONE);\")\n ([:create-table foo ([(a :default 10)])] '()\n \"CREATE TABLE foo (a &NONE DEFAULT 10);\")\n ([:create-table foo ([(a :primary-key :not-null) b])] '()\n \"CREATE TABLE foo (a &NONE PRIMARY KEY NOT NULL, b &NONE);\")\n ([:create-table foo ([a (b :check (< b 10))])] '()\n \"CREATE TABLE foo (a &NONE, b &NONE CHECK (b < 10));\")\n ([:create-table foo $S1] '([a b (c :primary-key)])\n \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE PRIMARY KEY);\")\n ([:create-table foo ([a b (c :default \"FOO\")])] '()\n \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE DEFAULT '\\\"FOO\\\"');\")\n ;; From select\n ([:create-table $i1 :as [:select name :from $i2]] '(names people)\n \"CREATE TABLE names AS (SELECT name FROM people);\")\n ;; Table constraints\n ([:create-table foo ([a b c] (:primary-key [a c]))] '()\n \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE, PRIMARY KEY (a, c));\")\n ([:create-table foo ([a b c] (:unique [a b c]))] '()\n \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE, UNIQUE (a, b, c));\")\n ([:create-table foo ([a b] (:check (< a b)))] '()\n \"CREATE TABLE foo (a &NONE, b &NONE, CHECK (a < b));\")\n ([:create-table foo ([a b c]\n ( :foreign-key [a b]\n :references bar [aa bb]\n :on-delete :cascade))]\n '()\n (concat \"CREATE TABLE foo (a &NONE, b &NONE, c &NONE, FOREIGN KEY (a, b) \"\n \"REFERENCES bar (aa, bb) ON DELETE CASCADE);\"))\n ;; Template\n ([:create-table $i1 $S2] '(foo [alpha beta delta])\n \"CREATE TABLE foo (alpha &NONE, beta &NONE, delta &NONE);\")\n ;; Drop table\n ([:drop-table $i1] '(foo)\n \"DROP TABLE foo;\")))\n\n(ert-deftest emacsql-update ()\n (emacsql-tests-with-queries\n ([:update people :set (= id $s1)] '(10)\n \"UPDATE people SET id = 10;\")))\n\n(ert-deftest emacsql-insert ()\n (emacsql-tests-with-queries\n ([:insert :into foo :values [nil $s1]] '(10.1)\n \"INSERT INTO foo VALUES (NULL, 10.1);\")\n ([:insert :into foo [a b] :values $v1] '([1 2])\n \"INSERT INTO foo (a, b) VALUES (1, 2);\")\n ([:replace :into $i1 :values $v2] '(bar ([1 2] [3 4]))\n \"REPLACE INTO bar VALUES (1, 2), (3, 4);\")))\n\n(ert-deftest emacsql-order-by ()\n (emacsql-tests-with-queries\n ([:order-by foo] '()\n \"ORDER BY foo;\")\n ([:order-by [$i1]] '(bar)\n \"ORDER BY bar;\")\n ([:order-by (- foo)] '()\n \"ORDER BY -foo;\")\n ([:order-by [(asc a) (desc (/ b 2))]] '()\n \"ORDER BY a ASC, b / 2 DESC;\")))\n\n(ert-deftest emacsql-limit ()\n (emacsql-tests-with-queries\n ([:limit 10] '()\n \"LIMIT 10;\")\n ([:limit $s1] '(11)\n \"LIMIT 11;\")\n ([:limit [12]] '()\n \"LIMIT 12;\")\n ([:limit [2 10]] '()\n \"LIMIT 2, 10;\")\n ([:limit [$s1 $s2]] '(4 30)\n \"LIMIT 4, 30;\")))\n\n(ert-deftest emacsql-quoting ()\n (emacsql-tests-with-queries\n ([:where (= name 'foo)] '()\n \"WHERE name = 'foo';\")\n ([:where (= name '$s1)] '(qux)\n \"WHERE name = 'qux';\")\n ([:where (like url (escape \"%`%%\" ?`))] '()\n \"WHERE url LIKE '\\\"%`%%\\\"' ESCAPE '`';\")))\n\n(ert-deftest emacsql-expr ()\n (emacsql-tests-with-queries\n ([:where (and a b)] '()\n \"WHERE a AND b;\")\n ([:where (or a $i1)] '(b)\n \"WHERE a OR b;\")\n ([:where (and $i1 $i2 $i3)] '(a b c)\n \"WHERE a AND b AND c;\")\n ([:where (is foo (not nil))] '()\n \"WHERE foo IS (NOT NULL);\")\n ([:where (is-not foo nil)] '()\n \"WHERE foo IS NOT NULL;\")\n ([:where (= attrib :name)] '()\n \"WHERE attrib = ':name';\")))\n\n(ert-deftest emacsql-transaction ()\n (emacsql-tests-with-queries\n ([:begin :transaction] '()\n \"BEGIN TRANSACTION;\")\n ([:begin :immediate] '()\n \"BEGIN IMMEDIATE;\")\n ([:rollback] '()\n \"ROLLBACK;\")\n ([:commit] '()\n \"COMMIT;\")))\n\n(ert-deftest emacsql-alter-table ()\n (emacsql-tests-with-queries\n ([:alter-table foo :rename-to bar] '()\n \"ALTER TABLE foo RENAME TO bar;\")\n ([:alter-table $i1 :rename-to $i2] '(alpha beta)\n \"ALTER TABLE alpha RENAME TO beta;\")\n ([:alter-table foo :add-column size :integer :not-null] '()\n \"ALTER TABLE foo ADD COLUMN size INTEGER NOT NULL;\")))\n\n(ert-deftest emacsql-funcall ()\n (emacsql-tests-with-queries\n ([:select (funcall count x)] '()\n \"SELECT count(x);\")\n ([:select (funcall count *)] '()\n \"SELECT count(*);\")\n ([:select (funcall group-concat x y)] '()\n \"SELECT group_concat(x, y);\")\n ([:select (funcall foobar :distinct x y)] '()\n \"SELECT foobar(':distinct', x, y);\")\n ([:select (funcall count :distinct x)] '()\n \"SELECT count(DISTINCT x);\")))\n\n(ert-deftest emacsql-precedence ()\n (emacsql-tests-with-queries\n ([:select (<< (not (is x nil)) 4)] '()\n \"SELECT (NOT x IS NULL) << 4;\")\n ([:select (* 3 (+ (/ 14 2) (- 5 3)))] '()\n \"SELECT 3 * (14 / 2 + (5 - 3));\")\n ([:select (- (|| (~ x) y))] '()\n \"SELECT -~x || y;\")\n ([:select (funcall length (|| (* x x) (* y y) (* z z)))] '()\n \"SELECT length((x * x) || (y * y) || (z * z));\")\n ([:select (and (+ (<= x y) 1) (>= y x))] '()\n \"SELECT (x <= y) + 1 AND y >= x;\")\n ([:select (or (& (<= x (+ y 1) (- z)) 1) (>= x z y))] '()\n \"SELECT (y + 1 BETWEEN x AND -z) & 1 OR z BETWEEN y AND x;\")))\n\n;;; emacsql-tests.el ends here\n" }, { "path": "test/emacsql-external-tests.el", "content": ";;; emacsql-external-tests.el --- Subprocess tests -*- lexical-binding:t -*-\n\n;; This is free and unencumbered software released into the public domain.\n\n;;; Code:\n\n(require 'cl-lib)\n(require 'ert)\n(require 'emacsql)\n\n(defvar emacsql-tests-timeout 4\n \"Be aggressive about not waiting on subprocesses in unit tests.\")\n\n(defvar emacsql-tests-connection-factories nil\n \"List of connection factories to use in unit tests.\")\n\n(defun emacsql-tests-add-connection-factory\n (connector &optional dep min pred envvars)\n (declare (indent defun))\n (cond\n ((and min (version< emacs-version min))\n (message \" ! skip `%s'; requires Emacs >= %s\" connector min))\n ((and dep (not (with-demoted-errors \"%S\" (require dep nil t))))\n (message \" ! skip `%s'; library `%s' not available\" connector dep))\n ((and pred (not (funcall pred)))\n (message \" ! skip `%s'; sanity check failed\" connector))\n ((not (with-demoted-errors \"%S\" (require connector nil t)))\n (message \" ! skip `%s'; failed to load library\" connector))\n ((let* ((unset ())\n (args (if envvars\n (mapcan (lambda (var)\n (let* ((envvar (car var))\n (keyword (cadr var))\n (value (and envvar (getenv envvar))))\n (cond ((not value) (push envvar unset) nil)\n (keyword (list keyword value))\n ((list value)))))\n envvars)\n (list nil))))\n (if unset\n (message \" ! skip `%s'; required envvars not set\" connector)\n (message \" test `%s' connector\" connector)\n (push (apply #'apply-partially connector args)\n emacsql-tests-connection-factories))))))\n\n(cl-eval-when (load eval)\n (emacsql-tests-add-connection-factory 'emacsql-sqlite-builtin 'sqlite \"29.1\"\n 'sqlite-available-p)\n\n (emacsql-tests-add-connection-factory 'emacsql-sqlite-module 'sqlite3 nil\n (lambda () (boundp 'module-file-suffix)))\n\n (emacsql-tests-add-connection-factory 'emacsql-mysql nil nil nil\n '((\"MYSQL_DATABASE\")\n (\"MYSQL_USER\" :user)\n (\"MYSQL_PASSWORD\" :password)\n (\"MYSQL_HOST\" :host)\n (\"MYSQL_PORT\" :port)))\n\n (emacsql-tests-add-connection-factory 'emacsql-psql nil nil nil\n '((\"PSQL_DATABASE\")\n (\"PSQL_USER\" :username)\n (\"PSQL_HOST\" :hostname)\n (\"PSQL_PORT\" :port)))\n\n (message \" ! skip `emacsql-pg' connector; known to be broken\")\n ;; FIXME Fix broken `emacsql-pg'.\n ;; (emacsql-tests-add-connection-factory 'emacsql-pg 'pg \"28.1\" nil\n ;; '((\"PG_DATABASE\")\n ;; (\"PG_USER\")\n ;; (\"PG_PASSWORD\" :password)\n ;; (\"PG_HOST\" :host)\n ;; (\"PG_PORT\" :port)))\n )\n\n(ert-deftest emacsql-basic ()\n \"A short test that fully interacts with SQLite.\"\n (let ((emacsql-global-timeout emacsql-tests-timeout))\n (dolist (factory emacsql-tests-connection-factories)\n (emacsql-with-connection (db (funcall factory))\n (emacsql db [:create-temporary-table foo ([x])])\n (should-error (emacsql db [:create-temporary-table foo ([x])]))\n (emacsql db [:insert :into foo :values ([1] [2] [3])])\n (should (equal (emacsql db [:select * :from foo])\n '((1) (2) (3))))))))\n\n(ert-deftest emacsql-nul-character ()\n \"Try inserting and retrieving strings with a NUL byte.\"\n (let ((emacsql-global-timeout emacsql-tests-timeout))\n (dolist (factory emacsql-tests-connection-factories)\n (emacsql-with-connection (db (funcall factory))\n (emacsql db [:create-temporary-table foo ([x])])\n (emacsql db [:insert :into foo :values ([\"a\\0bc\"])])\n (should (equal (emacsql db [:select * :from foo])\n '((\"a\\0bc\"))))))))\n\n(ert-deftest emacsql-foreign-key ()\n \"Tests that foreign keys work properly through EmacSQL.\"\n (let ((emacsql-global-timeout emacsql-tests-timeout))\n (dolist (factory emacsql-tests-connection-factories)\n (emacsql-with-connection (db (funcall factory))\n (unwind-protect\n (progn\n (emacsql-thread db\n [:create-table person ([(id integer :primary-key) name])]\n [:create-table likes\n ([(personid integer) color]\n (:foreign-key [personid] :references person [id]\n :on-delete :cascade))]\n [:insert :into person :values ([0 \"Chris\"] [1 \"Brian\"])])\n (should (equal (emacsql db [:select * :from person :order-by id])\n '((0 \"Chris\") (1 \"Brian\"))))\n (emacsql db [:insert :into likes\n :values ([0 red] [0 yellow] [1 yellow])])\n (should (equal (emacsql db [:select * :from likes\n :order-by [personid color]])\n '((0 red) (0 yellow) (1 yellow))))\n (emacsql db [:delete :from person :where (= id 0)])\n (should (equal (emacsql db [:select * :from likes])\n '((1 yellow)))))\n (emacsql-thread db\n [:drop-table likes]\n [:drop-table person]))))))\n\n(ert-deftest emacsql-error ()\n \"Check that we're getting expected conditions.\"\n (should-error (emacsql-compile nil [:insert :into foo :values 1])\n :type 'emacsql-syntax)\n (let ((emacsql-global-timeout emacsql-tests-timeout))\n (dolist (factory emacsql-tests-connection-factories)\n (emacsql-with-connection (db (funcall factory))\n (emacsql db [:create-temporary-table foo ([x])])\n (should-error (emacsql db [:create-temporary-table foo ([x])])\n :type 'emacsql-error)))))\n\n(ert-deftest emacsql-special-chars ()\n \"A short test that interacts with SQLite with special characters.\"\n (let ((emacsql-global-timeout 4))\n (dolist (factory emacsql-tests-connection-factories)\n (emacsql-with-connection (db (funcall factory))\n (emacsql db [:create-temporary-table test-table ([x])])\n (emacsql db [:insert-into test-table :values ([\"\u001c\"] [\\\u0004])])\n (when (cl-typep db 'process)\n (should (emacsql-live-p db)))\n (should (equal (emacsql db [:select * :from test-table])\n '((\"\u001c\") (\\\u0004))))))))\n\n;;; emacsql-external-tests.el ends here\n" } ]