[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/pgtk 25084b1: Merge remote-tracking branch 'origin/master' into
|
From: |
Po Lu |
|
Subject: |
feature/pgtk 25084b1: Merge remote-tracking branch 'origin/master' into feature/pgtk |
|
Date: |
Sat, 11 Dec 2021 05:34:19 -0500 (EST) |
branch: feature/pgtk
commit 25084b1e953ebe036e275a2cf5a6bb4de64a4008
Merge: ea8bb59 d90be27
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/pgtk
---
admin/CPP-DEFINES | 1 +
configure.ac | 25 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/text.texi | 146 ++++++++++
etc/NEWS | 8 +
lisp/net/shr.el | 2 +-
lisp/sqlite-mode.el | 206 ++++++++++++++
lisp/sqlite.el | 42 +++
lisp/term/w32-win.el | 1 +
lisp/textmodes/bibtex.el | 18 ++
src/Makefile.in | 7 +-
src/alloc.c | 1 +
src/data.c | 2 +
src/emacs.c | 1 +
src/haiku_support.cc | 2 -
src/lisp.h | 40 +++
src/pdumper.c | 4 +-
src/print.c | 16 ++
src/sqlite.c | 706 +++++++++++++++++++++++++++++++++++++++++++++++
src/xterm.c | 18 +-
test/src/sqlite-tests.el | 175 ++++++++++++
21 files changed, 1414 insertions(+), 8 deletions(-)
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index 634d6f3..620ab0b 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -288,6 +288,7 @@ HAVE_UTMP_H
HAVE_VFORK
HAVE_VFORK_H
HAVE_WEBP
+HAVE_SQLITE3
HAVE_WCHAR_H
HAVE_WCHAR_T
HAVE_WINDOW_SYSTEM
diff --git a/configure.ac b/configure.ac
index f67829b..892c3e0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -448,6 +448,7 @@ OPTION_DEFAULT_ON([gif],[don't compile with GIF image
support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
OPTION_DEFAULT_ON([webp],[don't compile with WebP image support])
+OPTION_DEFAULT_ON([sqlite3],[don't compile with sqlite3 support])
OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support])
OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing])
@@ -2694,6 +2695,27 @@ if test "${with_webp}" != "no"; then
fi
fi
+### Use -lsqlite3 if available, unless '--with-sqlite3=no'
+HAVE_SQLITE3=no
+if test "${with_sqlite3}" != "no"; then
+ AC_CHECK_LIB(sqlite3, sqlite3_open_v2, HAVE_SQLITE3=yes, HAVE_SQLITE3=no)
+ if test "$HAVE_SQLITE3" = "yes"; then
+ SQLITE3_LIBS=-lsqlite3
+ AC_SUBST(SQLITE3_LIBS)
+ LIBS="$SQLITE3_LIBS $LIBS"
+ AC_DEFINE(HAVE_SQLITE3, 1, [Define to 1 if you have the libsqlite3
library (-lsqlite).])
+ # Windows loads libwebp dynamically
+ if test "${opsys}" = "mingw32"; then
+ SQLITE3_LIBS=
+ fi
+ AC_CHECK_LIB(sqlite3, sqlite3_load_extension,
+ HAVE_SQLITE3_LOAD_EXTENSION=yes, HAVE_SQLITE3_LOAD_EXTENSION=no)
+ if test "$HAVE_SQLITE3_LOAD_EXTENSION" = "yes"; then
+ AC_DEFINE(HAVE_SQLITE3_LOAD_EXTENSION, 1, [Define to 1 if sqlite3
supports loading extensions.])
+ fi
+ fi
+fi
+
HAVE_IMAGEMAGICK=no
if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test
"${HAVE_W32}" = "yes" || \
test "${HAVE_BE_APP}" = "yes" || test "${window_system}" = "pgtk"; then
@@ -6233,7 +6255,7 @@ emacs_config_features=
for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM
GSETTINGS \
HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \
M17N_FLT MODULES NATIVE_COMP NOTIFY NS OLDXMENU PDUMPER PGTK PNG RSVG SECCOMP
\
- SOUND THREADS TIFF TOOLKIT_SCROLL_BARS \
+ SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS \
UNEXEC WEBP X11 XAW3D XDBE XFT XIM XINPUT2 XPM XWIDGETS X_TOOLKIT \
ZLIB; do
@@ -6280,6 +6302,7 @@ AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D
Does Emacs use a png library? ${HAVE_PNG} $LIBPNG
Does Emacs use -lrsvg-2? ${HAVE_RSVG}
Does Emacs use -lwebp? ${HAVE_WEBP}
+ Does Emacs use -lsqlite3? ${HAVE_SQLITE3}
Does Emacs use cairo? ${HAVE_CAIRO}
Does Emacs use -llcms2? ${HAVE_LCMS2}
Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 4f47a1d..b773ba8 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1224,6 +1224,7 @@ Text
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
+* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 03adb54..e964d7b 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -60,6 +60,7 @@ the character after point.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
+* Database:: Interacting with an SQL database.
* Parsing HTML/XML:: Parsing HTML and XML.
* Parsing JSON:: Parsing and generating JSON values.
* JSONRPC:: JSON Remote Procedure Call protocol
@@ -5135,6 +5136,151 @@ On success, it returns a list of a binary string (the
output) and the
IV used.
@end defun
+@node Database
+@section Database
+
+ Emacs can be compiled with built-in SQLite support.
+
+@defun sqlite-available-p
+The function returns non-@code{nil} if built-in SQLite support is
+available in this Emacs session.
+@end defun
+
+When SQLite support is available, the following functions can be used.
+
+@defun sqlite-open &optional file
+This function opens @var{file} as a database file. If it doesn't
+exist, a new database will be created and stored there. If this
+argument is missing or @code{nil}, a new in-memory database is created
+instead.
+
+The return value is a @dfn{database object} that can be used as the
+argument to most of the subsequent functions in this section of the
+manual.
+@end defun
+
+@defun sqlitep
+The database object returned by the @code{sqlite-open} function
+satisfies this predicate.
+@end defun
+
+@defun sqlite-close db
+Close the database @var{db}. It's usually not necessary to call this
+function explicitly---the database will automatically be closed if
+Emacs shuts down or the database object is garbage collected.
+@end defun
+
+@defun sqlite-execute db statement &optional values
+Execute the @acronym{SQL} @var{statement}. For instance:
+
+@lisp
+(sqlite-execute db "insert into foo values ('bar', 2)")
+@end lisp
+
+If the optional @var{values} parameter is present, it should be either
+a list or a vector of values to bind while executing the statement.
+For instance:
+
+@lisp
+(sqlite-execute db "insert into foo values (?, ?)" '("bar" 2))
+@end lisp
+
+This has exactly the same effect as the first form, but is more
+efficient and safer (because it doesn't involve any string parsing or
+interpolation).
+
+The number of affected rows is returned. For instance, an
+@samp{insert} statement will return @samp{1}, but an @samp{update}
+statement may return zero or a higher number.
+@end defun
+
+@defun sqlite-select db query &optional values result-type
+Select some data from @var{db} and return them. For instance:
+
+@lisp
+(sqlite-select db "select * from foo where key = 2")
+ @result{} (("bar" 2))
+@end lisp
+
+As with the @code{sqlite-execute} command, you can pass in a list or a
+vector of values that will be bound before executing the select:
+
+@lisp
+(sqlite-select db "select * from foo where key = ?" [2])
+ @result{} (("bar" 2))
+@end lisp
+
+This is usually more efficient and safer than the first method.
+
+This function, by default, returns a list of matching rows, where each
+row is a list of column values. If @var{return-type} is @code{full},
+the names of the columns (as a list of strings) will be returned as
+the first element in the return value.
+
+If @var{return-type} is @code{set}, this function will return a
+@dfn{statement object} instead. This object can be interrogated by
+the @code{sqlite-next}, @code{sqlite-columns} and @code{sqlite-more-p}
+functions. If the result set is small, it's often more convenient to
+just return the data directly, but if the result set is large (or if
+you won't be using all the data from the set), using the @code{set}
+method will allocate a lot less data, and therefore be more efficient.
+@end defun
+
+@defun sqlite-next statement
+This function returns the next row in the result set returned by
+@code{sqlite-select}.
+
+@lisp
+(sqlite-next stmt)
+ @result{} ("bar" 2)
+@end lisp
+@end defun
+
+@defun sqlite-columns statement
+This function returns the column names of the result set returned by
+@code{sqlite-select}.
+
+@lisp
+(sqlite-columns stmt)
+ @result{} ("name" "issue")
+@end lisp
+@end defun
+
+@defun sqlite-more-p statement
+This predicate says whether there is more data to be fetched in the
+result set returned by @code{sqlite-select}.
+@end defun
+
+@defun sqlite-finalize statement
+If @var{statement} is not going to be used any more, calling this
+function will free the resources bound by @var{statement}. This is
+usually not necessary---when the statement object is
+garbage-collected, this will happen automatically.
+@end defun
+
+@defun sqlite-transaction db
+Start a transaction in @var{db}. When in a transaction, other readers
+of the database won't access the results until the transaction has
+been committed.
+@end defun
+
+@defun sqlite-commit db
+End a transaction and write the data out to file.
+@end defun
+
+@defun sqlite-rollback db
+End a transaction and discard any changes that have been made.
+@end defun
+
+@defmac with-sqlite-transaction db &body body
+Like @code{progn}, but executes @var{body} with a transaction held,
+and do a commit at the end.
+@end defmac
+
+@defun sqlite-load-extension db module
+Load an extension into @var{db}. Extensions are usually @file{.so} files.
+@end defun
+
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html
diff --git a/etc/NEWS b/etc/NEWS
index 5285f52..b0dfa30 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -91,6 +91,14 @@ the 'variable-pitch' face, or add this to your "~/.emacs":
* Changes in Emacs 29.1
++++
+** Emacs now comes with optional built-in support for sqlite3.
+This allows you to examine and manipulate sqlite3 databases.
+
+** New command 'sqlite-mode-open-file' for examining an sqlite3 file.
+This uses the new 'sqlite-mode' which allows listing the tables
+in a file, the columns, and the contents of the tables.
+
---
** 'write-file' will now copy some file mode bits.
If the current buffer is visiting a file that is executable, the
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 829cf15..5f31f03 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -610,7 +610,7 @@ size, and full-buffer size."
(insert ? )
(shr-mark-fill start))
(put-text-property (1- (point)) (point) 'display ""))
- (put-text-property start (1+ start) 'shr-target-id id))
+ (put-text-property (1- (point)) (point) 'shr-target-id id))
;; If style is set, then this node has set the color.
(when style
(shr-colorize-region
diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el
new file mode 100644
index 0000000..61398c1
--- /dev/null
+++ b/lisp/sqlite-mode.el
@@ -0,0 +1,206 @@
+;;; sqlite-mode.el --- Mode for examining sqlite3 database files -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defvar-keymap sqlite-mode-map
+ "g" #'sqlite-mode-list-tables
+ "c" #'sqlite-mode-list-columns
+ "RET" #'sqlite-mode-list-data
+ "DEL" #'sqlite-mode-delete)
+
+(define-derived-mode sqlite-mode special-mode "Sqlite"
+ "This mode lists the contents of an .sqlite3 file"
+ :interactive nil
+ (buffer-disable-undo)
+ (setq-local buffer-read-only t
+ truncate-lines t))
+
+(defvar sqlite--db nil)
+
+;;;###autoload
+(defun sqlite-mode-open-file (file)
+ "Browse the contents of an sqlite file."
+ (interactive "fSQLite file name: ")
+ (pop-to-buffer (get-buffer-create
+ (format "*SQLite %s*" (file-name-nondirectory file))))
+ (sqlite-mode)
+ (setq-local sqlite--db (sqlite-open file))
+ (sqlite-mode-list-tables))
+
+(defun sqlite-mode-list-tables ()
+ "Re-list the tables from the currently selected database."
+ (interactive nil sqlite-mode)
+ (let ((inhibit-read-only t)
+ (db sqlite--db)
+ (entries nil))
+ (erase-buffer)
+ (dolist (table (sqlite-select db "select name from sqlite_schema where
type = 'table' and name not like 'sqlite_%' order by name"))
+ (push (list (car table)
+ (caar (sqlite-select db (format "select count(*) from %s"
+ (car table)))))
+ entries))
+ (sqlite-mode--tablify '("Table Name" "Number of Rows")
+ (nreverse entries)
+ 'table)
+ (goto-char (point-min))))
+
+(defun sqlite-mode--tablify (columns rows type &optional prefix)
+ (let ((widths
+ (mapcar
+ (lambda (i)
+ (1+ (seq-max (mapcar (lambda (row)
+ (length (format "%s" (nth i row))))
+ (cons columns rows)))))
+ (number-sequence 0 (1- (length columns))))))
+ (when prefix
+ (insert prefix))
+ (dotimes (i (length widths))
+ (insert (propertize (format (format "%%-%ds " (nth i widths))
+ (nth i columns))
+ 'face 'header-line)))
+ (insert "\n")
+ (dolist (row rows)
+ (let ((start (point)))
+ (when prefix
+ (insert prefix))
+ (dotimes (i (length widths))
+ (let ((elem (nth i row)))
+ (insert (format (format "%%%s%ds "
+ (if (numberp elem)
+ "" "-")
+ (nth i widths))
+ (if (numberp elem)
+ (nth i row)
+ (string-replace "\n" " " (or elem "")))))))
+ (put-text-property start (point) 'sqlite--row row)
+ (put-text-property start (point) 'sqlite--type type)
+ (insert "\n")))))
+
+(defun sqlite-mode-list-columns ()
+ "List the columns of the table under point."
+ (interactive nil sqlite-mode)
+ (let ((row (get-text-property (point) 'sqlite--row)))
+ (unless row
+ (user-error "No table under point"))
+ (let ((columns (sqlite-mode--column-names (car row)))
+ (inhibit-read-only t))
+ (save-excursion
+ (forward-line 1)
+ (if (looking-at " ")
+ ;; Delete the info.
+ (delete-region (point) (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ ;; Insert the info.
+ (dolist (column columns)
+ (insert (format " %s\n" column))))))))
+
+(defun sqlite-mode--column-names (table)
+ (let ((sql
+ (caar
+ (sqlite-select
+ sqlite--db
+ "select sql from sqlite_master where tbl_name = ? AND type =
'table'"
+ (list table)))))
+ (mapcar
+ #'string-trim
+ (split-string (replace-regexp-in-string "^.*(\\|)$" "" sql) ","))))
+
+(defun sqlite-mode-list-data ()
+ "List the data from the table under poing."
+ (interactive nil sqlite-mode)
+ (let ((row (and (eq (get-text-property (point) 'sqlite--type) 'table)
+ (get-text-property (point) 'sqlite--row))))
+ (unless row
+ (user-error "No table under point"))
+ (let ((inhibit-read-only t))
+ (save-excursion
+ (forward-line 1)
+ (if (looking-at " ")
+ ;; Delete the info.
+ (delete-region (point) (if (re-search-forward "^[^ ]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (sqlite--mode--list-data (list (car row) 0)))))))
+
+(defun sqlite-mode--more-data (stmt)
+ (let ((inhibit-read-only t))
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (sqlite--mode--list-data stmt)))
+
+(defun sqlite--mode--list-data (data)
+ (let* ((table (car data))
+ (rowid (cadr data))
+ stmt)
+ (unwind-protect
+ (progn
+ (setq stmt
+ (sqlite-select
+ sqlite--db
+ (format "select rowid, * from %s where rowid >= ?" table)
+ (list rowid)
+ 'set))
+ (sqlite-mode--tablify (sqlite-columns stmt)
+ (cl-loop for i from 0 upto 1000
+ for row = (sqlite-next stmt)
+ while row
+ do (setq rowid (car row))
+ collect row)
+ (cons 'row table)
+ " ")
+ (when (sqlite-more-p stmt)
+ (insert (buttonize " More data...\n" #'sqlite-mode--more-data
+ (list table rowid)))))
+ (when stmt
+ (sqlite-finalize stmt)))))
+
+(defun sqlite-mode-delete ()
+ "Delete the row under point."
+ (interactive nil sqlite-mode)
+ (let ((table (get-text-property (point) 'sqlite--type))
+ (row (get-text-property (point) 'sqlite--row))
+ (inhibit-read-only t))
+ (when (or (not (consp table))
+ (not (eq (car table) 'row)))
+ (user-error "No row under point"))
+ (unless (yes-or-no-p "Really delete the row under point? ")
+ (error "Not deleting"))
+ (sqlite-execute
+ sqlite--db
+ (format "delete from %s where %s"
+ (cdr table)
+ (string-join
+ (mapcar (lambda (column)
+ (format "%s = ?" (car (split-string column " "))))
+ (cons "rowid" (sqlite-mode--column-names (cdr table))))
+ " and "))
+ row)
+ (delete-region (line-beginning-position) (progn (forward-line 1)
(point)))))
+
+(provide 'sqlite-mode)
+
+;;; sqlite-mode.el ends here
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
new file mode 100644
index 0000000..dccdda1
--- /dev/null
+++ b/lisp/sqlite.el
@@ -0,0 +1,42 @@
+;;; sqlite.el --- Functions for interacting with sqlite3 databases -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defmacro with-sqlite-transaction (db &rest body)
+ "Execute BODY while holding a transaction for DB."
+ (declare (indent 1) (debug (form body)))
+ (let ((db-var (gensym)))
+ `(let ((,db-var ,db))
+ (if (sqlite-available-p)
+ (unwind-protect
+ (progn
+ (sqlite-transaction ,db-var)
+ ,@body)
+ (sqlite-commit ,db-var))
+ (progn
+ ,@body)))))
+
+(provide 'sqlite)
+
+;;; sqlite.el ends here
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index 8b745c4..0ee010b 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -275,6 +275,7 @@ See the documentation of `create-fontset-from-fontset-spec'
for the format.")
'(gif "libgif-5.dll" "giflib4.dll" "libungif4.dll" "libungif.dll")))
'(svg "librsvg-2-2.dll")
'(webp "libwebp-7.dll" "libwebp.dll")
+ '(sqlite3 "libsqlite3-0.dll")
'(gdk-pixbuf "libgdk_pixbuf-2.0-0.dll")
'(glib "libglib-2.0-0.dll")
'(gio "libgio-2.0-0.dll")
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index c06e8bf..2dd4e8e 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -839,6 +839,24 @@ for a new entry."
("eprint") ("eprintclass" nil nil 4) ("primaryclass" nil nil -4)
("eprinttype" nil nil 5) ("archiveprefix" nil nil -5)
("url") ("urldate")))
+ ("PhdThesis" "PhD Thesis"
+ (("author")
+ ("title" "Title of the PhD thesis")
+ ("school" "School where the PhD thesis was written")
+ ("year"))
+ nil
+ (("type" "Type of the PhD thesis")
+ ("address" "Address of the school (if not part of field \"school\") or
country")
+ ("month") ("note")))
+ ("TechReport" "Technical Report"
+ (("author")
+ ("title" "Title of the technical report (BibTeX converts it to
lowercase)")
+ ("institution" "Sponsoring institution of the report")
+ ("year"))
+ nil
+ (("type" "Type of the report (if other than \"technical report\")")
+ ("number" "Number of the technical report")
+ ("address") ("month") ("note")))
("Unpublished" "Unpublished"
(("author") ("title") ("date" nil nil 1) ("year" nil nil -1))
nil
diff --git a/src/Makefile.in b/src/Makefile.in
index 1a67d39..ee9a224 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -238,6 +238,8 @@ IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@
LIBXML2_LIBS = @LIBXML2_LIBS@
LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
+SQLITE3_LIBS = @SQLITE3_LIBS@
+
GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
LCMS2_LIBS = @LCMS2_LIBS@
@@ -429,7 +431,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o
$(XMENU_OBJ) window.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \
- thread.o systhread.o \
+ thread.o systhread.o sqlite.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
@@ -552,7 +554,8 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS)
$(LIBX_BASE) $(LIBIMAGE
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(HARFBUZZ_LIBS) $(LIBOTF_LIBS)
$(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
- $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS)
+ $(JSON_LIBS) $(LIBGMP) $(LIBGCCJIT_LIBS) $(XINPUT_LIBS) $(HAIKU_LIBS) \
+ $(SQLITE3_LIBS)
## FORCE it so that admin/unidata can decide whether this file is
## up-to-date. Although since charprop depends on bootstrap-emacs,
diff --git a/src/alloc.c b/src/alloc.c
index ff84598..16f9076 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -125,6 +125,7 @@ union emacs_align_type
struct Lisp_Overlay Lisp_Overlay;
struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table;
struct Lisp_Subr Lisp_Subr;
+ struct Lisp_Sqlite Lisp_Sqlite;
struct Lisp_User_Ptr Lisp_User_Ptr;
struct Lisp_Vector Lisp_Vector;
struct terminal terminal;
diff --git a/src/data.c b/src/data.c
index b2c3958..f07667b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -259,6 +259,8 @@ for example, (type-of 1) returns `integer'. */)
return Qxwidget;
case PVEC_XWIDGET_VIEW:
return Qxwidget_view;
+ case PVEC_SQLITE:
+ return Qsqlite;
/* "Impossible" cases. */
case PVEC_MISC_PTR:
case PVEC_OTHER:
diff --git a/src/emacs.c b/src/emacs.c
index 28b55d7..6048d12 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2186,6 +2186,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
#endif
syms_of_window ();
syms_of_xdisp ();
+ syms_of_sqlite ();
syms_of_font ();
#ifdef HAVE_WINDOW_SYSTEM
syms_of_fringe ();
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index d6d7967..b8f6e84 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -2663,10 +2663,8 @@ be_app_quit (void)
{
if (be_app)
{
- status_t e;
while (!be_app->Lock ());
be_app->Quit ();
- wait_for_thread (app_thread, &e);
}
}
diff --git a/src/lisp.h b/src/lisp.h
index d44ab55..92ab05b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1083,6 +1083,7 @@ enum pvec_type
PVEC_CONDVAR,
PVEC_MODULE_FUNCTION,
PVEC_NATIVE_COMP_UNIT,
+ PVEC_SQLITE,
/* These should be last, for internal_equal and sxhash_obj. */
PVEC_COMPILED,
@@ -2570,6 +2571,17 @@ xmint_pointer (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Misc_Ptr)->pointer;
}
+struct Lisp_Sqlite
+{
+ union vectorlike_header header;
+ void *db;
+ void *stmt;
+ char *name;
+ void (*finalizer) (void *);
+ bool eof;
+ bool is_statement;
+} GCALIGNED_STRUCT;
+
struct Lisp_User_Ptr
{
union vectorlike_header header;
@@ -2648,6 +2660,31 @@ XUSER_PTR (Lisp_Object a)
}
INLINE bool
+SQLITEP (Lisp_Object x)
+{
+ return PSEUDOVECTORP (x, PVEC_SQLITE);
+}
+
+INLINE bool
+SQLITE (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_SQLITE);
+}
+
+INLINE void
+CHECK_SQLITE (Lisp_Object x)
+{
+ CHECK_TYPE (SQLITE (x), Qsqlitep, x);
+}
+
+INLINE struct Lisp_Sqlite *
+XSQLITE (Lisp_Object a)
+{
+ eassert (SQLITEP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Sqlite);
+}
+
+INLINE bool
BIGNUMP (Lisp_Object x)
{
return PSEUDOVECTORP (x, PVEC_BIGNUM);
@@ -3793,6 +3830,9 @@ extern Lisp_Object safe_eval (Lisp_Object);
extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
+/* Defined in sqlite.c. */
+extern void syms_of_sqlite (void);
+
/* Defined in xsettings.c. */
extern void syms_of_xsettings (void);
diff --git a/src/pdumper.c b/src/pdumper.c
index 7ff079d..c758bc8 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2948,7 +2948,7 @@ dump_vectorlike (struct dump_context *ctx,
Lisp_Object lv,
dump_off offset)
{
-#if CHECK_STRUCTS && !defined HASH_pvec_type_F5BA506141
+#if CHECK_STRUCTS && !defined HASH_pvec_type_19F6CF5169
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
@@ -3028,6 +3028,8 @@ dump_vectorlike (struct dump_context *ctx,
error_unsupported_dump_object (ctx, lv, "mutex");
case PVEC_CONDVAR:
error_unsupported_dump_object (ctx, lv, "condvar");
+ case PVEC_SQLITE:
+ error_unsupported_dump_object (ctx, lv, "sqlite");
case PVEC_MODULE_FUNCTION:
error_unsupported_dump_object (ctx, lv, "module function");
default:
diff --git a/src/print.c b/src/print.c
index adadb28..214f1d1 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1875,6 +1875,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
break;
#endif
+ case PVEC_SQLITE:
+ {
+ print_c_string ("#<sqlite ", printcharfun);
+ int i = sprintf (buf, "db=%p", XSQLITE (obj)->db);
+ strout (buf, i, i, printcharfun);
+ if (XSQLITE (obj)->is_statement)
+ {
+ i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt);
+ strout (buf, i, i, printcharfun);
+ }
+ i = sprintf (buf, " name=%s", XSQLITE (obj)->name);
+ strout (buf, i, i, printcharfun);
+ printchar ('>', printcharfun);
+ }
+ break;
+
default:
emacs_abort ();
}
diff --git a/src/sqlite.c b/src/sqlite.c
new file mode 100644
index 0000000..d92dcf7
--- /dev/null
+++ b/src/sqlite.c
@@ -0,0 +1,706 @@
+/*
+Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+This file is based on the emacs-sqlite3 package written by Syohei
+YOSHIDA <syohex@gmail.com>, which can be found at:
+
+ https://github.com/syohex/emacs-sqlite3
+*/
+
+#include <config.h>
+#include "lisp.h"
+#include "coding.h"
+
+#ifdef HAVE_SQLITE3
+
+#include <sqlite3.h>
+
+#ifdef WINDOWSNT
+
+# include <windows.h>
+# include "w32common.h"
+# include "w32.h"
+
+DEF_DLL_FN (SQLITE_API int, sqlite3_finalize, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_close, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2,
+ (const char*, sqlite3**, int, const char*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text,
+ (sqlite3_stmt*, int, const char*, int, void(*)(void*)));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
+ (sqlite3_stmt*, int, sqlite3_int64));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_type, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API sqlite3_int64, sqlite3_column_int64,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API double, sqlite3_column_double, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const void*, sqlite3_column_blob,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_column_bytes, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const unsigned char*, sqlite3_column_text,
+ (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_column_name, (sqlite3_stmt*, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_exec,
+ (sqlite3*, const char*, int (*callback)(void*,int,char**,char**),
+ void*, char**));
+DEF_DLL_FN (SQLITE_API int, sqlite3_prepare_v2,
+ (sqlite3*, const char*, int, sqlite3_stmt**, const char**));
+
+# ifdef HAVE_SQLITE3_LOAD_EXTENSION
+DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
+ (sqlite3*, const char*, const char*, char**));
+# undef sqlite3_load_extension
+# define sqlite3_load_extension fn_sqlite3_load_extension
+# endif
+
+# undef sqlite3_finalize
+# undef sqlite3_close
+# undef sqlite3_open_v2
+# undef sqlite3_reset
+# undef sqlite3_bind_text
+# undef sqlite3_bind_int64
+# undef sqlite3_bind_double
+# undef sqlite3_bind_null
+# undef sqlite3_bind_int
+# undef sqlite3_errmsg
+# undef sqlite3_step
+# undef sqlite3_changes
+# undef sqlite3_column_count
+# undef sqlite3_column_type
+# undef sqlite3_column_int64
+# undef sqlite3_column_double
+# undef sqlite3_column_blob
+# undef sqlite3_column_bytes
+# undef sqlite3_column_text
+# undef sqlite3_column_name
+# undef sqlite3_exec
+# undef sqlite3_prepare_v2
+
+# define sqlite3_finalize fn_sqlite3_finalize
+# define sqlite3_close fn_sqlite3_close
+# define sqlite3_open_v2 fn_sqlite3_open_v2
+# define sqlite3_reset fn_sqlite3_reset
+# define sqlite3_bind_text fn_sqlite3_bind_text
+# define sqlite3_bind_int64 fn_sqlite3_bind_int64
+# define sqlite3_bind_double fn_sqlite3_bind_double
+# define sqlite3_bind_null fn_sqlite3_bind_null
+# define sqlite3_bind_int fn_sqlite3_bind_int
+# define sqlite3_errmsg fn_sqlite3_errmsg
+# define sqlite3_step fn_sqlite3_step
+# define sqlite3_changes fn_sqlite3_changes
+# define sqlite3_column_count fn_sqlite3_column_count
+# define sqlite3_column_type fn_sqlite3_column_type
+# define sqlite3_column_int64 fn_sqlite3_column_int64
+# define sqlite3_column_double fn_sqlite3_column_double
+# define sqlite3_column_blob fn_sqlite3_column_blob
+# define sqlite3_column_bytes fn_sqlite3_column_bytes
+# define sqlite3_column_text fn_sqlite3_column_text
+# define sqlite3_column_name fn_sqlite3_column_name
+# define sqlite3_exec fn_sqlite3_exec
+# define sqlite3_prepare_v2 fn_sqlite3_prepare_v2
+
+static bool
+load_dll_functions (HMODULE library)
+{
+ LOAD_DLL_FN (library, sqlite3_finalize);
+ LOAD_DLL_FN (library, sqlite3_close);
+ LOAD_DLL_FN (library, sqlite3_open_v2);
+ LOAD_DLL_FN (library, sqlite3_reset);
+ LOAD_DLL_FN (library, sqlite3_bind_text);
+ LOAD_DLL_FN (library, sqlite3_bind_int64);
+ LOAD_DLL_FN (library, sqlite3_bind_double);
+ LOAD_DLL_FN (library, sqlite3_bind_null);
+ LOAD_DLL_FN (library, sqlite3_bind_int);
+ LOAD_DLL_FN (library, sqlite3_errmsg);
+ LOAD_DLL_FN (library, sqlite3_step);
+ LOAD_DLL_FN (library, sqlite3_changes);
+ LOAD_DLL_FN (library, sqlite3_column_count);
+ LOAD_DLL_FN (library, sqlite3_column_type);
+ LOAD_DLL_FN (library, sqlite3_column_int64);
+ LOAD_DLL_FN (library, sqlite3_column_double);
+ LOAD_DLL_FN (library, sqlite3_column_blob);
+ LOAD_DLL_FN (library, sqlite3_column_bytes);
+ LOAD_DLL_FN (library, sqlite3_column_text);
+ LOAD_DLL_FN (library, sqlite3_column_name);
+ LOAD_DLL_FN (library, sqlite3_exec);
+# ifdef HAVE_SQLITE3_LOAD_EXTENSION
+ LOAD_DLL_FN (library, sqlite3_load_extension);
+# endif
+ LOAD_DLL_FN (library, sqlite3_prepare_v2);
+ return true;
+}
+#endif /* WINDOWSNT */
+
+static bool
+init_sqlite_functions (void)
+{
+#ifdef WINDOWSNT
+ static bool sqlite3_initialized;
+
+ if (!sqlite3_initialized)
+ {
+ HMODULE library = w32_delayed_load (Qsqlite3);
+
+ if (!library)
+ message1 ("sqlite3 library was not found");
+ else if (load_dll_functions (library))
+ {
+ sqlite3_initialized = true;
+ Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qt), Vlibrary_cache);
+ }
+ else
+ {
+ message1 ("sqlite3 library was found, but could not be loaded
successfully");
+ Vlibrary_cache = Fcons (Fcons (Qsqlite3, Qnil), Vlibrary_cache);
+ }
+ }
+ return sqlite3_initialized;
+#else /* !WINDOWSNT */
+ return true;
+#endif /* !WINDOWSNT */
+}
+
+
+static void
+sqlite_free (void *arg)
+{
+ struct Lisp_Sqlite *ptr = (struct Lisp_Sqlite *)arg;
+ if (ptr->is_statement)
+ sqlite3_finalize (ptr->stmt);
+ else if (ptr->db)
+ sqlite3_close (ptr->db);
+ xfree (ptr->name);
+ xfree (ptr);
+}
+
+static Lisp_Object
+encode_string (Lisp_Object string)
+{
+ if (STRING_MULTIBYTE (string))
+ return encode_string_utf_8 (string, Qnil, 0, Qt, Qt);
+ else
+ return string;
+}
+
+static Lisp_Object
+make_sqlite (bool is_statement, void *db, void *stmt, char *name)
+{
+ struct Lisp_Sqlite *ptr
+ = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Sqlite, PVEC_SQLITE);
+ ptr->is_statement = is_statement;
+ ptr->finalizer = sqlite_free;
+ ptr->db = db;
+ ptr->name = name;
+ ptr->stmt = stmt;
+ ptr->eof = false;
+ return make_lisp_ptr (ptr, Lisp_Vectorlike);
+}
+
+static void
+check_sqlite (Lisp_Object db, bool is_statement)
+{
+ init_sqlite_functions ();
+ CHECK_SQLITE (db);
+ if (is_statement && !XSQLITE (db)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid set object"));
+ else if (!is_statement && XSQLITE (db)->is_statement)
+ xsignal1 (Qerror, build_string ("Invalid database object"));
+ if (!is_statement && !XSQLITE (db)->db)
+ xsignal1 (Qerror, build_string ("Database closed"));
+ else if (is_statement && !XSQLITE (db)->db)
+ xsignal1 (Qerror, build_string ("Statement closed"));
+}
+
+static int db_count = 0;
+
+DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0,
+ doc: /* Open FILE as an sqlite database.
+If FILE is nil, an in-memory database will be opened instead. */)
+ (Lisp_Object file)
+{
+ char *name;
+ if (!init_sqlite_functions ())
+ xsignal1 (Qerror, build_string ("sqlite support is not available"));
+
+ if (!NILP (file))
+ {
+ CHECK_STRING (file);
+ file = encode_string (Fexpand_file_name (file, Qnil));
+ name = xstrdup (SSDATA (file));
+ }
+ else
+ /* In-memory database. These have to have different names to
+ refer to different databases. */
+ name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"),
+ make_int (++db_count))));
+
+ sqlite3 *sdb;
+ int ret = sqlite3_open_v2 (name,
+ &sdb,
+ SQLITE_OPEN_FULLMUTEX
+ | SQLITE_OPEN_READWRITE
+ | SQLITE_OPEN_CREATE
+ | (NILP (file) ? SQLITE_OPEN_MEMORY : 0)
+#ifdef SQLITE_OPEN_URI
+ | SQLITE_OPEN_URI
+#endif
+ | 0, NULL);
+
+ if (ret != SQLITE_OK)
+ return Qnil;
+
+ return make_sqlite (false, sdb, NULL, name);
+}
+
+DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0,
+ doc: /* Close the sqlite database DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ sqlite3_close (XSQLITE (db)->db);
+ XSQLITE (db)->db = NULL;
+ return Qt;
+}
+
+/* Bind values in a statement like
+ "insert into foo values (?, ?, ?)". */
+static const char *
+bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values)
+{
+ sqlite3_reset (stmt);
+ int len;
+ if (VECTORP (values))
+ len = ASIZE (values);
+ else
+ len = list_length (values);
+
+ for (int i = 0; i < len; ++i)
+ {
+ int ret = SQLITE_MISMATCH;
+ Lisp_Object value;
+ if (VECTORP (values))
+ value = AREF (values, i);
+ else
+ {
+ value = XCAR (values);
+ values = XCDR (values);
+ }
+ Lisp_Object type = Ftype_of (value);
+
+ if (EQ (type, Qstring))
+ {
+ Lisp_Object encoded = encode_string (value);
+ ret = sqlite3_bind_text (stmt, i + 1,
+ SSDATA (encoded), SBYTES (encoded),
+ NULL);
+ }
+ else if (EQ (type, Qinteger))
+ {
+ if (BIGNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
+ else
+ ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
+ }
+ else if (EQ (type, Qfloat))
+ ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
+ else if (NILP (value))
+ ret = sqlite3_bind_null (stmt, i + 1);
+ else if (EQ (value, Qt))
+ ret = sqlite3_bind_int (stmt, i + 1, 1);
+ else if (EQ (value, Qfalse))
+ ret = sqlite3_bind_int (stmt, i + 1, 0);
+ else
+ return "invalid argument";
+
+ if (ret != SQLITE_OK)
+ return sqlite3_errmsg (db);
+ }
+
+ return NULL;
+}
+
+DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
+ doc: /* Execute a non-select SQL statement.
+If VALUES is non-nil, it should be a vector or a list of values
+to bind when executing a statement like
+
+ insert into foo values (?, ?, ...)
+
+Value is the number of affected rows. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (query);
+ if (!(NILP (values) || CONSP (values) || VECTORP (values)))
+ xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+ Lisp_Object encoded = encode_string (query);
+ sqlite3_stmt *stmt = NULL;
+
+ /* We only execute the first statement -- if there's several
+ (separated by a semicolon), the subsequent statements won't be
+ done. */
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt != NULL)
+ {
+ sqlite3_finalize (stmt);
+ sqlite3_reset (stmt);
+ }
+
+ errmsg = sqlite3_errmsg (sdb);
+ goto exit;
+ }
+
+ /* Bind ? values. */
+ if (!NILP (values)) {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ ret = sqlite3_step (stmt);
+ sqlite3_finalize (stmt);
+ if (ret != SQLITE_OK && ret != SQLITE_DONE)
+ {
+ errmsg = sqlite3_errmsg (sdb);
+ goto exit;
+ }
+
+ retval = make_fixnum (sqlite3_changes (sdb));
+
+ exit:
+ if (errmsg != NULL)
+ xsignal1 (Qerror, build_string (errmsg));
+
+ return retval;
+}
+
+static Lisp_Object
+row_to_value (sqlite3_stmt *stmt)
+{
+ int len = sqlite3_column_count (stmt);
+ Lisp_Object values = Qnil;
+
+ for (int i = 0; i < len; ++i)
+ {
+ Lisp_Object v = Qnil;
+
+ switch (sqlite3_column_type (stmt, i))
+ {
+ case SQLITE_INTEGER:
+ v = make_int (sqlite3_column_int64 (stmt, i));
+ break;
+
+ case SQLITE_FLOAT:
+ v = make_float (sqlite3_column_double (stmt, i));
+ break;
+
+ case SQLITE_BLOB:
+ v =
+ code_convert_string_norecord
+ (make_unibyte_string (sqlite3_column_blob (stmt, i),
+ sqlite3_column_bytes (stmt, i)),
+ Qutf_8, false);
+ break;
+
+ case SQLITE_NULL:
+ v = Qnil;
+ break;
+
+ case SQLITE_TEXT:
+ v =
+ code_convert_string_norecord
+ (make_unibyte_string ((const char *)sqlite3_column_text (stmt, i),
+ sqlite3_column_bytes (stmt, i)),
+ Qutf_8, false);
+ break;
+ }
+
+ values = Fcons (v, values);
+ }
+
+ return Fnreverse (values);
+}
+
+static Lisp_Object
+column_names (sqlite3_stmt *stmt)
+{
+ Lisp_Object columns = Qnil;
+ int count = sqlite3_column_count (stmt);
+ for (int i = 0; i < count; ++i)
+ columns = Fcons (build_string (sqlite3_column_name (stmt, i)), columns);
+
+ return Fnreverse (columns);
+}
+
+DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select, 2, 4, 0,
+ doc: /* Select data from the database DB that matches QUERY.
+If VALUES is non-nil, it should be a list or a vector specifying the
+values that will be interpolated into a parameterized statement.
+
+By default, the return value is a list where the first element is a
+list of column names, and the rest of the elements are the matching data.
+
+RETURN-TYPE can be either nil (which means that the matching data
+should be returned as a list of rows), or `full' (the same, but the
+first element in the return list will be the column names), or `set',
+which means that we return a set object that can be queried with
+`sqlite-next' and other functions to get the data. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values,
+ Lisp_Object return_type)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (query);
+
+ if (!(NILP (values) || CONSP (values) || VECTORP (values)))
+ xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object retval = Qnil;
+ const char *errmsg = NULL;
+ Lisp_Object encoded = encode_string (query);
+
+ sqlite3_stmt *stmt = NULL;
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
+ &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt)
+ sqlite3_finalize (stmt);
+
+ goto exit;
+ }
+
+ /* Query with parameters. */
+ if (!NILP (values))
+ {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ sqlite3_finalize (stmt);
+ errmsg = err;
+ goto exit;
+ }
+ }
+
+ /* Return a handle to get the data. */
+ if (EQ (return_type, Qset))
+ {
+ retval = make_sqlite (true, sdb, stmt, XSQLITE (db)->name);
+ goto exit;
+ }
+
+ /* Return the data directly. */
+ Lisp_Object data = Qnil;
+ while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
+ data = Fcons (row_to_value (stmt), data);
+
+ if (EQ (return_type, Qfull))
+ retval = Fcons (column_names (stmt), Fnreverse (data));
+ else
+ retval = Fnreverse (data);
+ sqlite3_finalize (stmt);
+
+ exit:
+ if (errmsg != NULL)
+ xsignal1 (Qerror, build_string (errmsg));
+
+ return retval;
+}
+
+static Lisp_Object
+sqlite_exec (sqlite3 *sdb, const char *query)
+{
+ int ret = sqlite3_exec (sdb, query, NULL, NULL, NULL);
+ if (ret != SQLITE_OK)
+ return Qnil;
+
+ return Qt;
+}
+
+DEFUN ("sqlite-transaction", Fsqlite_transaction, Ssqlite_transaction, 1, 1, 0,
+ doc: /* Start a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "begin");
+}
+
+DEFUN ("sqlite-commit", Fsqlite_commit, Ssqlite_commit, 1, 1, 0,
+ doc: /* Commit a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "commit");
+}
+
+DEFUN ("sqlite-rollback", Fsqlite_rollback, Ssqlite_rollback, 1, 1, 0,
+ doc: /* Roll back a transaction in DB. */)
+ (Lisp_Object db)
+{
+ check_sqlite (db, false);
+ return sqlite_exec (XSQLITE (db)->db, "rollback");
+}
+
+#ifdef HAVE_SQLITE3_LOAD_EXTENSION
+DEFUN ("sqlite-load-extension", Fsqlite_load_extension,
+ Ssqlite_load_extension, 2, 2, 0,
+ doc: /* Load an SQlite MODULE into DB.
+MODULE should be the name of an SQlite module's file, a
+shared library in the system-dependent format and having a
+system-dependent file-name extension. */)
+ (Lisp_Object db, Lisp_Object module)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (module);
+ Lisp_Object module_encoded = encode_string (Fexpand_file_name (module,
Qnil));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ int result = sqlite3_load_extension (sdb, SSDATA (module_encoded),
+ NULL, NULL);
+ if (result == SQLITE_OK)
+ return Qt;
+ return Qnil;
+}
+#endif /* HAVE_SQLITE3_LOAD_EXTENSION */
+
+DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
+ doc: /* Return the next result set from SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+
+ int ret = sqlite3_step (XSQLITE (set)->stmt);
+ if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
+ xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
+
+ if (ret == SQLITE_DONE)
+ {
+ XSQLITE (set)->eof = true;
+ return Qnil;
+ }
+
+ return row_to_value (XSQLITE (set)->stmt);
+}
+
+DEFUN ("sqlite-columns", Fsqlite_columns, Ssqlite_columns, 1, 1, 0,
+ doc: /* Return the column names of SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+ return column_names (XSQLITE (set)->stmt);
+}
+
+DEFUN ("sqlite-more-p", Fsqlite_more_p, Ssqlite_more_p, 1, 1, 0,
+ doc: /* Say whether there are any further results in SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+
+ if (XSQLITE (set)->eof)
+ return Qnil;
+ else
+ return Qt;
+}
+
+DEFUN ("sqlite-finalize", Fsqlite_finalize, Ssqlite_finalize, 1, 1, 0,
+ doc: /* Mark this SET as being finished.
+This will free the resources held by SET. */)
+ (Lisp_Object set)
+{
+ check_sqlite (set, true);
+ sqlite3_finalize (XSQLITE (set)->stmt);
+ XSQLITE (set)->db = NULL;
+ return Qt;
+}
+
+#endif /* HAVE_SQLITE3 */
+
+DEFUN ("sqlitep", Fsqlitep, Ssqlitep, 1, 1, 0,
+ doc: /* Say whether OBJECT is an SQlite object. */)
+ (Lisp_Object object)
+{
+#ifdef HAVE_SQLITE3
+ return SQLITE (object)? Qt: Qnil;
+#else
+ return Qnil;
+#endif
+}
+
+DEFUN ("sqlite-available-p", Fsqlite_available_p, Ssqlite_available_p, 0, 0, 0,
+ doc: /* Return t if sqlite3 support is available in this instance of
Emacs.*/)
+ (void)
+{
+#ifdef HAVE_SQLITE3
+# ifdef WINDOWSNT
+ Lisp_Object found = Fassq (Qsqlite3, Vlibrary_cache);
+ if (CONSP (found))
+ return XCDR (found);
+ else
+ return init_sqlite_functions () ? Qt : Qnil;
+# else
+ return Qt;
+#endif
+#else
+ return Qnil;
+#endif
+}
+
+void
+syms_of_sqlite (void)
+{
+#ifdef HAVE_SQLITE3
+ defsubr (&Ssqlite_open);
+ defsubr (&Ssqlite_close);
+ defsubr (&Ssqlite_execute);
+ defsubr (&Ssqlite_select);
+ defsubr (&Ssqlite_transaction);
+ defsubr (&Ssqlite_commit);
+ defsubr (&Ssqlite_rollback);
+#ifdef HAVE_SQLITE3_LOAD_EXTENSION
+ defsubr (&Ssqlite_load_extension);
+#endif
+ defsubr (&Ssqlite_next);
+ defsubr (&Ssqlite_columns);
+ defsubr (&Ssqlite_more_p);
+ defsubr (&Ssqlite_finalize);
+ DEFSYM (Qset, "set");
+ DEFSYM (Qfull, "full");
+#endif
+ defsubr (&Ssqlitep);
+ DEFSYM (Qsqlitep, "sqlitep");
+ defsubr (&Ssqlite_available_p);
+ DEFSYM (Qfalse, "false");
+ DEFSYM (Qsqlite, "sqlite");
+ DEFSYM (Qsqlite3, "sqlite3");
+}
diff --git a/src/xterm.c b/src/xterm.c
index ae0daa7..f212945 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -9851,7 +9851,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
XIValuatorState *states;
double *values;
bool found_valuator = false;
+#ifdef HAVE_XWIDGETS
bool any_stop_p = false;
+#endif /* HAVE_XWIDGETS */
/* A fake XMotionEvent for x_note_mouse_movement. */
XMotionEvent ev;
@@ -9988,6 +9990,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
struct xi_scroll_valuator_t *val;
double delta, scroll_unit;
+ int scroll_height;
+ Lisp_Object window;
/* See the comment on top of
@@ -10054,7 +10058,19 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xev->mods.effective);
}
- scroll_unit = pow (FRAME_PIXEL_HEIGHT (f), 2.0 / 3.0);
+ window = window_from_coordinates (f, xev->event_x,
+ xev->event_y, NULL,
+ false, false);
+
+ if (WINDOWP (window))
+ scroll_height = XWINDOW (window)->pixel_height;
+ else
+ /* EVENT_X and EVENT_Y can be outside the
+ frame if F holds the input grab, so fall
+ back to the height of the frame instead. */
+ scroll_height = FRAME_PIXEL_HEIGHT (f);
+
+ scroll_unit = pow (scroll_height, 2.0 / 3.0);
if (NUMBERP (Vx_scroll_event_delta_factor))
scroll_unit *= XFLOATINT
(Vx_scroll_event_delta_factor);
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
new file mode 100644
index 0000000..7ccea1c
--- /dev/null
+++ b/test/src/sqlite-tests.el
@@ -0,0 +1,175 @@
+;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+
+(ert-deftest sqlite-select ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (should (eq (type-of db) 'sqlite))
+ (should (sqlitep db))
+ (should-not (sqlitep 'foo))
+
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer, col3
float, col4 blob)")))
+
+ (should-error
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45,
'bar', 'zot')"))
+
+ (should
+ (=
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45,
'bar')")
+ 1))
+
+ (should
+ (equal
+ (sqlite-select db "select * from test1" nil 'full)
+ '(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar"))))))
+
+(ert-deftest sqlite-set ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open))
+ set)
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer)")))
+
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('foo', 1)")
+ 1))
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('bar', 2)")
+ 1))
+
+ (setq set (sqlite-select db "select * from test1" nil 'set))
+ (should (sqlitep set))
+ (should (sqlite-more-p set))
+ (should (equal (sqlite-next set)
+ '("foo" 1)))
+ (should (equal (sqlite-next set)
+ '("bar" 2)))
+ (should-not (sqlite-next set))
+ (should-not (sqlite-more-p set))
+ (sqlite-finalize set)
+ (should-error (sqlite-next set))))
+
+(ert-deftest sqlite-chars ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test2 (col1 text, col2 integer)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fóo', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fóo', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fo', 4)")
+ (should
+ (equal (sqlite-select db "select * from test2" nil 'full)
+ '(("col1" "col2") ("fóo" 3) ("fóo" 3) ("fo" 4))))))
+
+(ert-deftest sqlite-numbers ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test3 (col1 integer)")
+ (let ((big (expt 2 50))
+ (small (expt 2 10)))
+ (sqlite-execute db (format "insert into test3 values (%d)" small))
+ (sqlite-execute db (format "insert into test3 values (%d)" big))
+ (should
+ (equal
+ (sqlite-select db "select * from test3")
+ (list (list small) (list big)))))))
+
+(ert-deftest sqlite-param ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test4 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test4 values (?, ?)" (list "foo" 1))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" '(1))
+ '(("foo" 1))))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" [1])
+ '(("foo" 1))))))
+
+(ert-deftest sqlite-binary ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test5 (col1 text, col2 number)")
+ (let ((string (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert 0 1 2)
+ (buffer-string))))
+ (should-not (multibyte-string-p string))
+ (sqlite-execute
+ db "insert into test5 values (?, ?)" (list string 2))
+ (let ((out (caar
+ (sqlite-select db "select col1 from test5 where col2 = 2"))))
+ (should (equal out string))))))
+
+(ert-deftest sqlite-different-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db1 db2)
+ (setq db1 (sqlite-open))
+ (setq db2 (sqlite-open))
+ (sqlite-execute
+ db1 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db2 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db1 "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db1 "select * from test6"))
+ (should-not (sqlite-select db2 "select * from test6"))))
+
+(ert-deftest sqlite-close-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db "select * from test6"))
+ (sqlite-close db)
+ (should-error (sqlite-select db "select * from test6"))))
+
+;;; sqlite-tests.el ends here